Question

我正在编写一个比较两列数据的宏，然后识别在两列中找到重复数据的行。我的程序的那部分工作。但是，我不知道如何在两个独立的＆＃34; Subs＆＃34;在VBA中。如果你第一次看到我的代码，就会更容易解释。

Function DuplicateFinder(SheetName1 As String, SheetName2 As String)

Dim D As Object, C
Dim nda As Long, ndb As Long
Dim test As Range
Dim StorageArray(1000)
Dim increment
increment=0   

Set D = CreateObject("scripting.dictionary")
Sheets(SheetName2).Select
ndb = Range("O" & Rows.count).End(xlUp).Row
Sheets(SheetName1).Select
nda = Range("O" & Rows.count).End(xlUp).Row

For Each C In Range("O2:O" & nda)
    D(C.Value) = 1
    C.Select
Next C

Sheets(SheetName2).Select
For Each C In Range("O2:O" & ndb)
    If D(C.Value) = 1 Then
        C.Select

        StorageArray(increment) = C.Value ' this is where i want to store the C value.
    End If
    If Len(C) = 0 Then
        C.Interior.Color = vbRed
        MsgBox "Macro terminated at the blank red cell," & Chr(10) & _
            "as per instructions"

    End If
Next C

End Function

Sub MainFunction()

Dim A As String
Dim B As String
Dim C As String
Dim D As String

A = "Sheet 1 Name"
B = "Sheet 2 Name"
C = "Sheet 3 Name"
D = "Sheet 4 Name"
increment = 0


Call DuplicateFinder(Sheet 1 Name, Sheet 2 Name)
'I would then call the function 5 more times to compare each column in each sheet to one another

End Sub

第一个功能用于比较列的数据＆＃39; 1＆＃39;和列＆＃39; 2＆＃39;，然后识别每列中存在重复数据的单元格。同样，那部分有效。第二个sub只是用于运行代码的主要函数。我想做的事情，并且不知道怎么做，每次DuplicateFinder找到重复内容时，它都会保存数据＆＃39;在数组中。但是，我需要运行DuplicateFinder函数6次来比较工作簿中每个工作表的数据。例如，如果工作表名称是A，B，C和D.我需要运行比较A到B，A到C，A到D，B到C，B到D的函数，以及最后C到D.但是，保存在数组中的数据仅在DuplicateFinder函数中可用。

我在想也许解决方案是让函数返回值，但我不明白它是如何工作的。我很感激任何人的意见。

Answer 1

您可以使用此表示法作为函数返回类型从函数返回数组：

Public Function MyFunction（param1 As String，param2 As String） As 串（）

例如：

Option Explicit Sub MainFunction() Const WS_NAMES As String = "Sheet1, Sheet2, Sheet3" Dim ws() As String, dups() As Variant, i As Integer, totalWS As Long ws = Split(WS_NAMES, ", ") totalWS = UBound(ws) ReDim dups(totalWS) dups(0) = DuplicateFinder(ws(0), ws(1)) dups(1) = DuplicateFinder(ws(0), ws(2)) dups(2) = DuplicateFinder(ws(1), ws(2)) MsgBox dups(0)(1) MsgBox dups(1)(1) MsgBox dups(2)(0) End Sub Function DuplicateFinder(SheetName1 As String, SheetName2 As String) As String() Dim StorageArray(1) As String StorageArray(0) = SheetName1 StorageArray(1) = SheetName2 DuplicateFinder = StorageArray End Function

Answer 2

您可以使用模块级变量来避免传递数组。

Private Duplicates() As String
Private NumDups As Long

Sub MainFunction()

Dim A As String
Dim B As String
Dim C As String
Dim D As String

A = "Sheet 1 Name"
B = "Sheet 2 Name"
C = "Sheet 3 Name"
D = "Sheet 4 Name"

NumDups = 0
ReDim Duplicates(NumDups)

Call DuplicateFinder(A, B)
Call DuplicateFinder(A, C)
Call DuplicateFinder(A, D)
Call DuplicateFinder(B, C)
Call DuplicateFinder(B, D)
Call DuplicateFinder(C, D)

End Sub

Function DuplicateFinder(SheetName1 As String, SheetName2 As String)

Dim D As Object
Dim C As Range
Dim nda As Long, ndb As Long

Set D = CreateObject("scripting.dictionary")
Sheets(SheetName2).Select
ndb = Range("O" & Rows.Count).End(xlUp).Row
Sheets(SheetName1).Select
nda = Range("O" & Rows.Count).End(xlUp).Row

For Each C In Range("O2:O" & nda)
    D(C.Value) = 1
Next C

Sheets(SheetName2).Select
For Each C In Range("O2:O" & ndb)
    If D(C.Value) = 1 Then
        NumDups = NumDups + 1
        ReDim Preserve Duplicates(NumDups)
        Duplicates(NumDups - 1) = C.Value
    End If
    If Len(C.Value) = 0 Then
        C.Interior.Color = vbRed
        MsgBox "Macro terminated at the blank red cell," & Chr(10) & _
            "as per instructions"
    End If
Next C

End Function

在VBA中使用两个子函数的数组

2 个答案: