Excel -基于表1中的值在表2中创建新行

wlzqhblo  于 2023-05-19  发布在  其他
关注(0)|答案(1)|浏览(90)

我有一本有三个电子表格的工作簿。
Sheet 1、Sheet 2和Sheet 3通过唯一标识符链接在一起。
Sheet 1只能有每个唯一标识符的1个示例;然而,表2和表3可以具有多个示例。
假设唯一ID从表1 A2开始:A541。我想旁边的一列(B2:B541),当一个数字输入它的副本,唯一的ID sheet 2在列A的次数指定。

Sheet1 Column A
ID
2023_0001
2023_0002
2023_0003

Sheet1 Column B
Copy_to_Sheet2
2
3
2

Sheet1 Column C
Copy_to_Sheet3
3
2
2

这将把ID 2023_0001复制2次到Sheet 2作为新行,复制3次到Sheet 3
这可能吗?
我对VBA语法不是很熟悉,但我尝试过Google的一些其他解决方案。我只是不知道如何调整它们以适应我的需要。这一个工作,但我不想担心提示。我在尽量让我的员工轻松点。

Sub CopyData()
Updateby Extendoffice
Dim Rng As Range
Dim InputRng As Range, OutRng As Range
xTitleId = "KutoolsforExcel"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8)
Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)
Set OutRng = OutRng.Range("A1")
For Each Rng In InputRng.Rows
    xValue = Rng.Range("A1").Value
    xNum = Rng.Range("B1").Value
    OutRng.Resize(xNum, 1).Value = xValue
    Set OutRng = OutRng.Offset(xNum, 0)
Next
End Sub
6jjcrrmo

6jjcrrmo1#

如果不需要提示,可以将代码作为Worksheet_Change事件,而不是编写单独的模块。就像这样:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 2 Then
    NoCopy = Target.Value
    CopyVal = Sheets("Sheet1").Cells(Target.Row, 1)
    x = Sheets("Sheet2").Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
For y = 1 To NoCopy
        Sheets("Sheet2").Cells(x + y, 1) = CopyVal
    Next y
ElseIf Target.Column = 3 Then
    NoCopy = Target.Value
    CopyVal = Sheets("Sheet1").Cells(Target.Row, 1)
    x = Sheets("Sheet3").Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
    For y = 1 To NoCopy
        Sheets("Sheet3").Cells(x + y, 1) = CopyVal
    Next y
End If

End Sub

你需要把它放在微软Excel对象的“Sheet1”中,而不是一个模块,但这样它就可以像人们添加到B列和C列一样工作。我假设A列中的值在B或C之前

相关问题