Fatal编程技术网
  • vba/
  • VBA在2个不同大小的范围内循环

VBA在2个不同大小的范围内循环

vba excel

VBA在2个不同大小的范围内循环,vba,excel,Vba,Excel,甚至不确定这是否可能，也不确定其背后的逻辑（上周才开始使用VBA），但我需要帮助在两个不同的范围内循环，这两个范围大小不同，但ID相似 在一张纸上我有大约1500行，大约700个唯一ID，在第二张纸上我有650行，都是唯一的。目前我遇到的问题是，它将在650行中循环，但由于第一行中有额外的唯一ID，所以我大约少了100行 到目前为止，我的代码如下，可能还有其他一些错误，或者我正在做一些可能会导致不同问题的事情，但仍在学习，因此任何帮助都将不胜感激 哦，我可以通过将比较3改回表2来让它工作！R2C

甚至不确定这是否可能，也不确定其背后的逻辑（上周才开始使用VBA），但我需要帮助在两个不同的范围内循环，这两个范围大小不同，但ID相似

在一张纸上我有大约1500行，大约700个唯一ID，在第二张纸上我有650行，都是唯一的。目前我遇到的问题是，它将在650行中循环，但由于第一行中有额外的唯一ID，所以我大约少了100行

到目前为止，我的代码如下，可能还有其他一些错误，或者我正在做一些可能会导致不同问题的事情，但仍在学习，因此任何帮助都将不胜感激

哦，我可以通过将比较3改回表2来让它工作！R2C1:R700C1，但我希望我能让它以尽可能少的设定值工作

自动取款机，我在上面出错了

 Selection.FormulaArray = _
            "=INDEX(Sheet2!R2C1:R700C7,MATCH(1,(" & comparison & " = " & comparison3 & ")*(" & comparison1 & "= Sheet2!R2C7:R700C7),0),2)"
与比较3相比，要通过的唯一值更少

Function compare(FieldName As String, FieldName1 As String, FieldName2 As String) As Boolean

Dim wkb As Workbook
Dim ws, ws1 As Worksheet
Dim lRow As Long, lRow1, lRow2 As Long
Dim aCell As Range, rng1 As Range, aCell1 As Range, rng2 As Range, aCell2 As Range, aCell3 As Range
encrypt = True
Dim x As Integer
x = 2
Dim comparison As String
Dim comparison1 As Integer
Dim comparison2 As String
Dim comparison3 As String
Dim comparison4 As Integer
Dim y As Integer
Dim aCellComparison, aCellComparison1, aCellComparison2 As Range
Dim a As Integer
a = 2

 Set wkb = ActiveWorkbook

 With wkb

    Set ws = ActiveSheet
    Set ws1 = wkb.Sheets("Sheet2")

    '~~> Find the cell which has the name
 Set aCell = ws.Range("A1:Z1").Find(FieldName, LookAt:=xlWhole)
 Set aCell1 = ws.Range("A1:Z1").Find(FieldName1, LookAt:=xlWhole)
 Set aCell2 = ws.Range("A1:Z1").Find("HOS_PROC_FIXED_COST", LookAt:=xlWhole)
 Set aCell3 = ws.Range("A1:Z1").Find(FieldName2, LookAt:=xlWhole)
 Set aCellComparison = ws1.Range("A1:Z1").Find("Code", LookAt:=xlWhole)
 Set aCellComparison1 = ws1.Range("A1:Z1").Find("LOS", LookAt:=xlWhole)

  If aCell Is Nothing Then
        compare = False
  End If

  If Not aCell Is Nothing Then
  lRow = ws.Range(Split(ws.Cells(, aCell.Column).Address, "$")(1) &    ws.Rows.Count).End(xlUp).Row
 lRow1 = ws.Range(Split(ws.Cells(, aCell1.Column).Address, "$")(1) & ws.Rows.Count).End(xlUp).Row
 lRow2 = ws.Range(Split(ws.Cells(, aCell2.Column).Address, "$")(1) & ws.Rows.Count).End(xlUp).Row



 Set rng1 = ws.Range(ws.Cells(x, aCell.Column), ws.Cells(lRow, aCell.Column))
 Set rng2 = ws1.Range(ws1.Cells(x, aCellComparison.Column), ws1.Cells(lRow,  aCellComparison.Column))
 If lRow And lRow1 And lRow2 > 1 Then
            '~~> Set your Range


    Columns("J:J").Select
    Selection.Insert Shift:=xlToRight
    y = aCell2.Column
 For Each c In rng1

        comparison = ws.Cells(x, aCell.Column).Value
        comparison1 = ws.Cells(x, aCell1.Column).Value
        comparison2 = ws.Cells(x, aCell3.Column).Value
        comparison3 = ws1.Cells(a, aCellComparison.Column).Value
        comparison4 = ws1.Cells(a, aCellComparison.Column).Value

        Range("J" & x).Select
        Application.CutCopyMode = False


        If ((x > 2) And (comparison <> ws.Cells(x - 1, aCell.Column).Value)) Then
            a = a + 1
        End If

    If comparison2 = "1" Then

     Selection.FormulaArray = _
            "=INDEX(Sheet2!R2C1:R700C7,MATCH(1,(" & comparison & " = " & comparison3 & ")*(" & comparison1 & "= Sheet2!R2C7:R700C7),0),2)"

    ElseIf comparison2 = "2" Then
        Selection.FormulaArray = _
            "=INDEX(Sheet2!R2C1:R700C7,MATCH(1,(" & comparison & "=    Sheet2!R2C1:R700C1)*(" & comparison1 & "= Sheet2!R2C7:R700C7),0),3)"
    ElseIf comparison2 = "3" Then
        Selection.FormulaArray = _
            "=INDEX(Sheet2!R2C1:R700C7,MATCH(1,(" & comparison & "=  Sheet2!R2C1:R700C1)*(" & comparison1 & "= Sheet2!R2C7:R700C7),0),4)"
    ElseIf comparison2 = "6" Then
    Selection.FormulaArray = _
            "=INDEX(Sheet2!R2C1:R700C7,MATCH(1,(" & comparison & "=       Sheet2!R2C1:R700C1)*(" & comparison1 & "= Sheet2!R2C7:R700C7),0),5)"
    End If

    x = x + 1
Next



End If
End If
End With
End Function

函数比较（FieldName为字符串，FieldName1为字符串，FieldName2为字符串）为布尔值
将wkb设置为工作簿
Dim ws，ws1作为工作表
变暗lRow为长，lRow1、lRow2为长
调暗aCell作为范围、rng1作为范围、aCell1作为范围、rng2作为范围、aCell2作为范围、aCell3作为范围
加密=真
作为整数的Dim x
x=2
将比较设置为字符串
Dim comparison1作为整数
作为字符串的Dim比较2
作为字符串的Dim比较N3
作为整数的Dim比较N4
Dim y作为整数
Dim aCellComparison、aCellComparison1、aCellComparison2作为范围
将a变暗为整数
a=2
设置wkb=ActiveWorkbook
与西九龙文娱艺术区
设置ws=ActiveSheet
设置ws1=wkb.Sheets（“Sheet2”）
“~~>查找具有名称的单元格
设置aCell=ws.Range（“A1:Z1”）.Find（FieldName，LookAt:=xlother）
设置aCell1=ws.Range（“A1:Z1”）.Find（FieldName1，LookAt:=xlother）
设置aCell2=ws.Range（“A1:Z1”）.Find（“HOS\u PROC\u FIXED\u COST”，LookAt:=xltotal）
设置aCell3=ws.Range（“A1:Z1”）.Find（FieldName2，LookAt:=xlother）
设置aCellComparison=ws1.Range（“A1:Z1”）.Find（“代码”，LookAt:=xlother）
设置aCellComparison1=ws1.Range（“A1:Z1”）.Find（“LOS”，LookAt:=xlother）
如果艾塞尔什么都不是
比较=假
如果结束
如果不是的话，亚塞尔什么都不是
lRow=ws.Range（拆分（ws.Cells（，aCell.Column）.Address，“$”（1）和ws.Rows.Count）。结束（xlUp）。行
lRow1=ws.Range（拆分（ws.Cells（，aCell1.Column）.Address，“$”（1）和ws.Rows.Count）。结束（xlUp）。行
lRow2=ws.Range（拆分（ws.Cells（，aCell2.Column）.Address，“$”（1）和ws.Rows.Count）。结束（xlUp）。行
设置rng1=ws.Range（ws.Cells（x，aCell.Column），ws.Cells（lRow，aCell.Column））
设置rng2=ws1.Range（ws1.Cells（x，aCellComparison.Column），ws1.Cells（lRow，aCellComparison.Column））
如果lRow和lRow1以及lRow2>1，则
“~~>设置您的范围
列（“J:J”）。选择
选择。插入移位：=xlToRight
y=aCell2.列
对于rng1中的每个c
比较=ws.Cells（x，aCell.Column）.Value
comparison1=ws.Cells（x，aCell1.Column）.Value
comparison2=ws.Cells（x，aCell3.Column）.Value
comparison3=ws1.Cells（a，aCellComparison.Column）.Value
comparison4=ws1.Cells（a，aCellComparison.Column）.Value
范围（“J”和x）。选择
Application.CutCopyMode=False
如果（（x>2）和（比较ws.Cells（x-1，aCell.Column.Value）），则
a=a+1
如果结束
如果comparison2=“1”，则
Selection.FormulaArray=_
=索引（Sheet2！R2C1:R700C7，匹配（1，（&comparison&=“&comparison3&”）*（&comparison1&“=Sheet2！R2C7:R700C7），0），2）
ElseIf comparison2=“2”然后
Selection.FormulaArray=_
=INDEX（Sheet2！R2C1:R700C7，匹配（1，（&comparison&）=Sheet2！R2C1:R700C1）*（&comparison1&=Sheet2！R2C7:R700C7），0），3）
ElseIf comparison2=“3”然后
Selection.FormulaArray=_
=索引（Sheet2！R2C1:R700C7，匹配（1，（&comparison&）=Sheet2！R2C1:R700C1）*（&comparison1&=Sheet2！R2C7:R700C7），0），4）
ElseIf comparison2=“6”然后
Selection.FormulaArray=_
=索引（Sheet2！R2C1:R700C7，匹配（1，（&comparison&）=Sheet2！R2C1:R700C1）*（&comparison1&=Sheet2！R2C7:R700C7），0），5）
如果结束
x=x+1
下一个
如果结束
如果结束
以
端函数
我可以建议您使用脚本.Dictionary对象吗？在VBA IDE中，转到菜单工具->参考，并从可用参考中检查标记为Microsoft脚本运行时的库。然后您可以编写如下代码来比较两组代码

Sub T()


    Dim dicFirst As Scripting.Dictionary
    Set dicFirst = New Scripting.Dictionary

    'loop adding numbers from first set
    Dim v
    For Each v In Range("FirstIDs").Cells
        dicFirst.Add v, Empty
    Next v


    Dim dicSecond As Scripting.Dictionary
    Set dicSecond = New Scripting.Dictionary

    'loop adding numbers from second set
    For Each v In Range("SecondIDs").Cells
        dicSecond.Add v, Empty
    Next v

    'to find all ids in first but not second...
    For Each v In dicFirst.Keys
        If Not dicSecond.Exists(v) Then
            Debug.Print v & " in 1 but not 2"
        End If
    Next v

    'to find all ids in second but not first ...
    For Each v In dicSecond.Keys
        If Not dicFirst.Exists(v) Then
            Debug.Print v & " in 2 but not 1"
        End If
    Next v

End Sub
现在我自己也开始工作了。以防万一将来有人需要它。代码如下

Function compare(FieldName As String, FieldName1 As String, FieldName2 As String) As Boolean

Dim wkb As Workbook
Dim ws, ws1 As Worksheet
Dim lRow As Long, lRow1, lRow2 As Long
Dim aCell As Range, rng1 As Range, aCell1 As Range, rng2 As Range, aCell2 As Range, aCell3 As Range
encrypt = True
Dim aCellUnique As Range
Dim x As Integer
x = 1
Dim comparison As String
Dim comparison1 As Integer
Dim comparison2 As String
Dim comparison3 As String
Dim comparison4 As Integer
Dim y As Integer
Dim aCellComparison, aCellComparison1, aCellComparison2 As Range
Dim a As Integer
a = 2

Set wkb = ActiveWorkbook

With wkb

    Set ws = ActiveSheet
    Set ws1 = wkb.Sheets("Sheet2")

    '~~> Find the cell which has the name
Set aCell = ws.Range("A1:Z1").Find(FieldName, LookAt:=xlWhole)
Set aCell1 = ws.Range("A1:Z1").Find(FieldName1, LookAt:=xlWhole)
Set aCell2 = ws.Range("A1:Z1").Find("HOS_PROC_FIXED_COST", LookAt:=xlWhole)
Set aCell3 = ws.Range("A1:Z1").Find(FieldName2, LookAt:=xlWhole)
Set aCellComparison = ws1.Range("A1:Z1").Find("Code", LookAt:=xlWhole)
Set aCellComparison1 = ws1.Range("A1:Z1").Find("LOS", LookAt:=xlWhole)


If aCell Is Nothing Then
        compare = False
 End If

 If Not aCell Is Nothing Then
 lRow = ws.Range(Split(ws.Cells(, aCell.Column).Address, "$")(1) & ws.Rows.Count).End(xlUp).Row
 lRow1 = ws.Range(Split(ws.Cells(, aCell1.Column).Address, "$")(1) & ws.Rows.Count).End(xlUp).Row
 lRow2 = ws1.Range(Split(ws1.Cells(, aCellComparison.Column).Address, "$")(1) & ws1.Rows.Count).End(xlUp).Row



 Set rng1 = ws.Range(ws.Cells(x, aCell.Column), ws.Cells(lRow, aCell.Column))
 Set rng2 = ws1.Range(ws1.Cells(x, aCellComparison.Column), ws1.Cells(lRow2,  aCellComparison.Column))
 If lRow And lRow1 And lRow2 > 1 Then
            '~~> Set your Range


    Columns("J:J").Select
    Selection.Insert Shift:=xlToRight
    y = aCell2.Column

 For Each c In rng1

        x = x + 1
        comparison = ws.Cells(x, aCell.Column).Value
        comparison1 = ws.Cells(x, aCell1.Column).Value
        comparison2 = ws.Cells(x, aCell3.Column).Value
        comparison3 = ws1.Cells(a, aCellComparison.Column).Value
        comparison4 = ws1.Cells(a, aCellComparison1.Column).Value

        If ((x > 2) And (comparison <> comparison3)) Then

                a = a + 1
                comparison3 = ws1.Cells(a, aCellComparison.Column).Value
                comparison4 = ws1.Cells(a, aCellComparison1.Column).Value

        End If



  If comparison <> comparison3 Then
    Do Until comparison = comparison3
        x = x + 1
        comparison = ws.Cells(x, aCell.Column).Value
        comparison1 = ws.Cells(x, aCell1.Column).Value
        comparison2 = ws.Cells(x, aCell3.Column).Value
    Loop

        End If





        Range("J" & x).Select
        Application.CutCopyMode = False


    If comparison2 = "1" Then

     Selection.FormulaArray = _
            "=INDEX(Sheet2!R2C1:R700C7,MATCH(1,(" & comparison & " = " & comparison3 & ")*(" & comparison1 & "= Sheet2!R2C7:R700C7),0),2)"

    ElseIf comparison2 = "2" Then
        Selection.FormulaArray = _
            "=INDEX(Sheet2!R2C1:R700C7,MATCH(1,(" & comparison & "= Sheet2!R2C1:R700C1)*(" & comparison1 & "= Sheet2!R2C7:R700C7),0),3)"
    ElseIf comparison2 = "3" Then
        Selection.FormulaArray = _
            "=INDEX(Sheet2!R2C1:R700C7,MATCH(1,(" & comparison & "= Sheet2!R2C1:R700C1)*(" & comparison1 & "= Sheet2!R2C7:R700C7),0),4)"
    ElseIf comparison2 = "6" Then
    Selection.FormulaArray = _
            "=INDEX(Sheet2!R2C1:R700C7,MATCH(1,(" & comparison & "= Sheet2!R2C1:R700C1)*(" & comparison1 & "= Sheet2!R2C7:R700C7),0),5)"
    End If

Next



 End If
 End If 
 End With
 End Function

函数比较（FieldName为字符串，FieldName1为字符串，FieldName2为字符串）为布尔值
将wkb设置为工作簿
Dim ws，ws1作为工作表
变暗lRow为长，lRow1、lRow2为长
调暗aCell作为范围、rng1作为范围、aCell1作为范围、rng2作为范围、aCell2作为范围、aCell3作为范围
加密=真
Dim Acellas系列
作为整数的Dim x
x=1
将比较设置为字符串
Dim comparison1作为整数
作为字符串的Dim比较2
作为字符串的Dim比较N3
作为整数的Dim比较N4
Dim y作为整数
Dim aCellComparison、aCellComparison1、aCellComparison2作为范围
将a变暗为整数
a=2
设置wkb=ActiveWorkbook
与西九龙文娱艺术区
设置ws=ActiveSheet
设置ws1=wkb.Sheets（“Sheet2”）
“~~>查找具有名称的单元格
设置aCell=ws.Range（“A1:Z1”）.Find（FieldName，LookAt:=xlother）
设置aCell1=ws.Range（“A1:Z1”）.Find（FieldName1，LookAt:=xlother）
设置aCell2=ws.Range（“A1:Z1”）.Find（“HOS\u PROC\u FIXED\u COST”，LookAt:=xltotal）
设置aCell3=ws.Range（“A1:Z1”）.Find（FieldName2，LookAt:=xlother）
设置aCellComparison=ws1.Range（“A1:Z1”）.Find（“代码”，LookAt:=xlother）
设置aCellComparison1=ws1.Range（“A1:Z1”）.Find（“LOS”，LookAt:=xlother）
如果艾塞尔什么都不是
比较=假
如果结束
如果不是的话，亚塞尔什么都不是
lRow=ws.Range（拆分（ws.Cells（，aCell.Column）.Address，“$”（1）和ws.Rows.Count）。结束（xlUp）。行
lRow1=ws.Range（拆分（ws.Cells（，aCell1.Column）.Address，“$”（1）和ws.Rows.Count）。结束（xlUp）。行
lRow2=ws1.量程（Sp