Question

通过社区的帮助，我构建了这段代码，我根据某些标准对数据进行排序。我的问题出现在FormulaArray部分，我有一个伪编码版本，我想要代码现在做，但我不太确定如何让它100％工作任何帮助非常感谢。谢谢！

Sub BringData()

Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim wb3 As Workbook

Application.ScreenUpdating = False
Set wb1 = Workbooks.Open(ThisWorkbook.Path & "\book1-2.xlsm")
ThisWorkbook.Activate
Application.ScreenUpdating = True

 wb1.SaveAs (ThisWorkbook.Path & "\book1-2copy.xlsm")

Application.ScreenUpdating = False
Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\book2.xlsm")
ThisWorkbook.Activate
Application.ScreenUpdating = True

 Set wb3 = ThisWorkbook

Dim parameter1 As String
Dim condition1 As String
Dim parameter2 As String
Dim condition2 As String
Dim value As String

Dim ws2 As Worksheet
Dim ws1 As Worksheet
Set ws2 = wb2.Sheets(1)
Set ws1 = wb1.Sheets(1)
Dim destination1 As Worksheet
Dim destination2 As Worksheet
Dim emptyColumn1 As Long
Dim lastFullColumn1 As Long

Set destination1 = ws1
lastFullColumn1 = destination1.Cells(1,      destination1.Columns.Count).End(xlToLeft).Column
If lastFullColumn1 > 1 Then
emptyColumn1 = lastFullColumn1 + 1
End If

Dim startrow As Range
Dim stoprow As Range
Dim l As Long

With wb3.Sheets("Sheet1")

Set startrow = .Columns("E").Find(What:="START", LookIn:=xlValues,    lookat:=xlWhole)
Set stoprow = .Columns("E").Find(What:="STOP", LookIn:=xlValues, lookat:=xlWhole)

End With

   For l = startrow.Row + 1 To stoprow.Row - 1

   Application.ScreenUpdating = False

   With wb3.Sheets("Sheet1")

   parameter1 = .Cells(l, 6)
   condition1 = .Cells(l, 7)
   parameter2 = .Cells(l, 8)
   condition2 = .Cells(l, 9)
   value = .Cells(l, 10)

    End With

    With wb1.Sheets(1).Range(ws1.Cells(1, 1), ws1.Cells(1, lastFullColumn1))


            Dim parameter1column As Range
            Set parameter1column = .Find(What:=wb3.Sheets("sheet1").Cells(l, 6).value, LookIn:=xlValues, lookat:=xlWhole)
            Dim parameter1columnLetter As String
            parameter1columnLetter = ColumnLetter(parameter1column.Column)

            Dim parameter2column As Range
            Set parameter2column = .Find(What:=wb3.Sheets("sheet1").Cells(l, 8).value, LookIn:=xlValues, lookat:=xlWhole)
            Dim parameter2columnLetter As String
            parameter2columnLetter = ColumnLetter(parameter2column.Column)

            Dim valuecolumn As Range
            Set valuecolumn = .Find(What:=wb3.Sheets("sheet1").Cells(l, 10).value, LookIn:=xlValues, lookat:=xlWhole)
            Dim valuecolumnLetter As String
           valuecolumnLetter = ColumnLetter(valuecolumn.Column)




            Dim lastFullcolumn2letter As String
            Dim lastFullColumn2 As Long
            Dim emptyColumn2 As Long
            Dim emptycolumn2letter As String

            Set destination2 = ws2
                lastFullColumn2 = destination2.Cells(1, destination2.Columns.Count).End(xlToLeft).Column
            If lastFullColumn2 > 1 Then
                emptyColumn2 = lastFullColumn2 + 1
            End If

            lastFullcolumn2letter = ColumnLetter(lastFullColumn2)
            emptycolumn2letter = ColumnLetter(emptyColumn2)



            Dim patid1 As Range
            Dim patid2 As Range

            Set patid1 = wb1.Sheets(1).Range("D:D")
            Set patid2 = wb2.Sheets(1).Range("D:D")

            Dim parameter1columnvalue As Range
            Set parameter1columnvalue =   Columns(parameter1column.Column).Cells

             Dim parameter2ColumnValue As Range
             Set parameter2ColumnValue = Columns(parameter2column.Column).Cells

            Dim valuecolumnValue As Range
            Set valuecolumnValue = Columns(valuecolumn.Column).Cells




            Dim i As Long
            Dim k As Long
            Dim m As Long
           Dim Lookupstring As String

            With ws2

            .Range("emptycolumn2letter").FormulaArray = "=INDEX(ws1! valuecolumnletter:valuecolumnletter, MATCH(1, (ws1! parameter1columvalue= wb3.Sheets(1) condition1.value)*(ws1! parameter2columnvalue = wb3.Sheets(1) condition1.value)*(patid1=patid2), 0))"
            .Range("emptycolumn2letter") =  .Range("emptycolumn2letter").value


            End With

    End With

    Application.ScreenUpdating = True

Next l

SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox " This code ran in " & SecondsElapsed & "seconds", vbInformation

End Sub

我遇到麻烦的地方是：

With ws2
    .Range("emptycolumn2letter").FormulaArray = "=INDEX(ws1! valuecolumnletter:valuecolumnletter, MATCH(1, (ws1! parameter1columvalue= wb3.Sheets(1) condition1.value)*(ws1! parameter2columnvalue = wb3.Sheets(1) condition1.value)*(patid1=patid2), 0))"
    .Range("emptycolumn2letter") =  .Range("emptycolumn2letter").value    
 End With

修改

Dim lastFullRow1 As Long
lastFullRow1 = destination1.Cells(destination1.Rows.Count,  1).End(xlUp).Row
If lastFullRow1 > 1 Then
emptyrow1 = lastFullRow1 + 1
End If

Set destination2 = ws2
Dim lastFullRow2 As Long
lastFullRow2 = destination2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
If lastFullRow2 > 1 Then
emptyrow2 = lastFullRow2 + 1
End If

    Dim pasterange As String
    Dim patid As String
    Dim condition1s As String
    Dim condition2s As String
    Dim values As String

    pasterange =  "lastfullcolumn2letter2:lastfullcolumn2letterlastfullrow2"
    patid = "D:D"
    condition1s = "parameter1columnletter1:parameter1columnletterlastfullrow1"
    condition2s = "parameter2columnletter1:parameter2columnletterlastfullrow1"
    values = "valuecolumnletter:valuecolumnletterlastfullrow1"

    MsgBox "column row " & condition1s

    With ws2

    .Range(pasterange).FormulaArray = _
        "=INDEX('" & ws2.Name & " '!' " & patid & ", " & _
        "MATCH(1,('" & ws1.Name & "'!" & condition1s & "=" & condition1 & ")*" & _
                "('" & ws1.Name & "'!" & condition2s & "=" & condition2 & ")*" & _
                "('" & ws1.Name & "'!" & values & "=" & value & "),0))"
        .Range(pasterange) = .Range(pasterange).value

    End With

Answer 1

使用公式作为VBA WorksheetFunction object和在工作表单元格中编写公式之间有几个混搭。

您对emptycolumn2letter的使用有两个问题。正如用户3714330在评论中所提到的，它似乎不是完整的单元格引用;只是专栏信。 .Range("C2")或.Range("C:C")有效。 .Range("C")不是。此外，一旦emptycolumn2letter具有有效的单元格地址，您就不会引用它;例如.Range(emptycolumn2letter)不是.Range("emptycolumn2letter")。你只会使用后者emptycolumn2letter是工作表上的命名范围。它不是;它是VBA程序中的变量。

同样地，除非工作表的名称字面上ws1，否则不能使用ws1。你需要打破公式字符串，并在公式字符串中使用ws1.name连接。

在相关的说明中，从字符串构造公式时，最好使用工作表名称周围的单引号。如果工作表名称不包含空格，则不需要它们，但如果包含它们则不会造成伤害。如果需要它们而不是那里，那么公式就会破裂。

dim ec2L as string, p1cv as string, p2cv as string, p3cv as string, vcl as string
ec2L = "Z3"
vcl = "$D$2:$D$1112"
p1cv = "$A$2:$A$1112"
p2cv = "$C$2:$C$1112"
p3cv = "$B$2:$B$1112"
With ws2
    'formula to duplicate:
    '[INDEX($D$2:$D$1112, MATCH(1, ($A$2:$A$1112=$U$7)*($C$2:$C$1112=$W$7)*($B$2:$B$1112=F3), 0))]
    .Range(ec2L).FormulaArray = _
      "=INDEX('" & ws1.name & "'!" & vcl & ", " & _
        "MATCH(1, ('" & ws1.name & "'!" & p1cv & "=" & condition1 & ")*" & _
                 "('" & ws1.name & "'!" & p2cv & "=" & condition2 & ")*" & _
                 "('" & ws1.name & "'!" & p3cv & "=" & condition3 & "), 0))
    .Range(ec2L) =  .Range(ec2L).value    
End With

这不是完全'交钥匙'的正确，因为在你的子程序中有许多代码超过了这个代码，但它应该让你知道应该努力的方向。请注意，condition1，condition2和condition3被视为数字。如果它们是文本，那么它们也需要用引号括起来。

您可能会发现使用单元格Address property和external:=true是一种更方便的方法，可以将工作表名称和单元格地址整合到公式中。

将公式转换为VBA

1 个答案: