Question

描述：有两个工作表，其中一个用作原始数据集（主数据）的文件，第二个对应于原始数据的更新。主文件的大小为A1：L，其中第一行代表名称。更新文件数据的范围为：A1：Q，其中第一行再次对应于列名。在更新文件的列D中，存在项目编号（ID），其以未指定的顺序对应于主文件的列G中的ID。在更新文件的Q列中，有三个标准：价格，文本，文本和价格。在更新文件的B列中，有两个条件：删除和更新。

我的任务步骤：

步骤1：宏找到两者之间的匹配：更新文件中的列D和主文件中的列G.

步骤2：如果步骤1中存在匹配，则宏检查列B值：

•如果单元格包含“delete”，则在与找到的匹配单元格对应的主文件的L列中插入日期值（如变量中所定义：vDato）。

•步骤3：如果单元格包含“update”，那么请转到更新文件的Q列并继续执行以下操作：

如果单元格值是“text”，那么不要做任何事情（退出）

如果单元格值为“price”或“text and price”，则在找到的匹配项目编号后添加一行，并将价格值从更新工作表中的O列复制粘贴到单元格中主表中的第I列。

挑战：两个文件都减少了大约30.000行，所以宏必须通过数组进行。首先，我尝试将范围输入到数组中并通过循环使用IF语句，但是，宏运行但没有发生任何事情。然后，我尝试在一个新工作表中合并两个数组，这又包含一些错误。我明白我想要达到的目标非常复杂，但是，我希望你们，伙计们能帮助我。

我的第一个宏：

Sub OpdatereArkEfterNyInfo()
Dim i As Long, j As Long, lCol As Long, X As Long
Dim opdTabel As Variant, hovTabel As Variant
Dim arOutputUp(), arOutputH()
Dim vDato As Variant, Varer As Variant, PrisTekst As Variant
vDato = InputBox("Angiv opdateringsdatoen", "Identifikator")
If Len(vDato) = 0 Then Exit Sub
opdTabel = Sheets("update").Range("A1").CurrentRegion
'ReDim arOutputUp(1 To UBound(opdTabel), 1 To UBound(opdTabel))
'opdTabel = Sheets("update").Range("A1:Q" & Sheets("update").Range("A1").CurrentRegion.Rows.Count)
 hovTabel = Sheets("Compliance2").Range("A1").CurrentRegion
'ReDim arOutputH(1 To UBound(hovTabel), 1 To UBound(hovTabel))
'hovTabel = Sheets("Compliance2").Range("A1:N" & Sheets("Compliance2").Range("A1").CurrentRegion.Rows.Count)
X = 1
For i = 2 To UBound(opdTabel)
For j = 2 To UBound(hovTabel)
       If (opdTabel(i, 4) = hovTabel(j, 7)) Then
        If (opdTabel(i, 2) = "delete") Then
        hovTabel(j, 12) = vDato
         If (opdTabel(i, 2) = "update") Then
                    If (opdTabel(i, 17) = "tekst") Then
                    Exit For
                        If (opdTabel(i, 17) = "pris") Or (opdTabel(i, 17) = "Tekst og pris") Then 
                        Rows(i).EntireRow.Insert
                        hovTabel(j + 1, 9) = opdTabel(i, 15) And vDato = hovTabel(j + 1, 11)
                        For lCol = 1 To UBound(hovTabel)
                                arOutputH(X, lCol) = hovTabel(i, lCol)
                            Next
                            X = X + 1
End If
                    End If
                End If
            End If
       End If
    Next
Next

If X = 1 Then
MsgBox "No IDs are matched"
End If
Worksheets.Add.Name = "test"
Range("A1").Resize(UBound(arOutputH), UBound(arOutputH, 2)) = arOutputH 
End Sub

在我的第二个宏中，我尝试定义数组并在两个数据集中基于ID合并它们，但是代码根本没有匹配部分。

好的，我已经找到了如何添加其他代码。继续进行结构后，我的代码如下：

Sub Plan_Main（） Dim WsMaster，WbUpdate，vDato As Variant Dim i，j，k As Long

WsMaster =表格（“WsMaster”）。范围（“A1：Q”和表格（“WsMaster”）。范围（“A1”）。CurrentRegion.Rows.Count） WbUpdate =表格（“WbUpdate”）。范围（“A1：N”和表格（“WbUpdate”）。范围（“A1”）。CurrentRegion.Rows.Count）

vDato = InputBox（“插入更新日期”，“标识符”）如果Len（vDato）= 0则退出Sub

Application.ScreenUpdating = False

k = 1
For i = 2 To UBound(WbUpdate)
    For j = 2 To UBound(WsMaster)
      If (WbUpdate(j, 4) = WsMaster(i, 7)) Then
        'If there is a match Then
            If (WbUpdate(i, 2) = "delete") Then
            ' If Update.Column(B) = "Delete"
            ' Let WsMaster.Column(L) = vDato
                WsMaster(j, 12) = vDato
                ' If Update.Column(B) is "Update"
                If (WbUpdate(j, 2) = "update") Then
                    ' If Update.Column(Q) = "Price" Or "Text and price"
                        If (WbUpdate(i, 17) = "Price" Or "Text og Price") Then
                        ' Add row in WsMaster below matched row - here I am not aware af how I proceed with adding a row
                          Sheets("WsMaster").Range("A:Q" & Sheets("WsMaster").Range("A:Q").CurrentRegion.Rows.Count + 1) = WbUpdate(i, 15)
                          ' Copy price from WsUpdate.Column(O) to WsMaster.Column(I) in the new row
                           WsMaster.Range("I" & j.Row) = WbUpdate.Range("O" & i.Row).Offset(1, 0)
                          'If Update.Column(Q) = "Text"
                          If (WbUpdate(i, 17) = "Text") Then
                           ' do nothing
                          Exit For
                          k = k + 1
                          End If
                        End If
                End If
            End If
        End If
    Next
Next

Application.ScreenUpdating = True

'如果没有匹配那么如果k = 1那么 MsgBox“找不到匹配” 结束如果

End Sub

Answer 1

您的计划既不精确又不完整，并且不会尝试满足您的要求。您的要求是将任务分解为您可以在小步骤后逐步管理的任务。所以，这就是你的计划应该是这样的： -

Sub Plan_Main()

    ' Open the Master workbook = Activeworkbook (containing the code) = WbMaster
    ' Open the Update workbook = WbUpdate

    ' Name the Master worksheet = WsMaster
    ' Name the Update worksheet = WsUpdate

    ' Loop through all items in Update, start with row 2

        ' Take the value in column D
        ' Look for a match in WsMaster.Column(G)
        ' If there is a match Then
            ' If Update.Column(B) = "Delete"
                ' Let WsMaster.Column(L) = WsUpdate.Column(??)
            ' If Update.Column(B) is "Update"
                ' If Update.Column(Q) = "Price" Or "Text and price"
                    ' Add row in WsMaster below matched row
                    ' Copy price from WsUpdate.Column(O) to WsMaster.Column(??) in the new row
                ' If Update.Column(Q) = "Text"
                    ' do nothing

        ' If there is no match Then
End Sub

首先填写我不熟悉或未经您定义的部分。然后开始逐行将思想转化为代码。如果它太难了，可以将一行单词分成几行。如果你知道你想说什么，不知道要使用的表达来到这个网站。很多人都想帮忙。

VB宏通过数组基于几个条件合并到数据集

1 个答案: