时间戳

首页 > 解决方案 > 在 Excel VBA 中合并两个相同的模块

excel - 在 Excel VBA 中合并两个相同的模块

问题描述

可以帮我合并这两个模块，以便我可以多次使用它们吗？

第一个模块：

Private Sub UserForm_Initialize()
    
Dim ultimaLin As Long, area As New Collection
Dim Value As Variant, temp() As Variant

On Error Resume Next
  
ultimaLin = Sheets("DBTemp").Range("A" & Rows.Count).End(xlUp).Row
temp = Sheets("DBTemp").Range("A2:A" & ultimaLin).Value

For Each Value In temp
If Len(Value) > 0 Then area.Add Value, CStr(Value)
Next Value

For Each Value In area

titulo_livro.AddItem Value

Next Value

Set area = Nothing

End Sub

第二个模块：

Private Sub UserForm_Initialize()

Dim ultimaLin As Long, area As New Collection
Dim Value As Variant, temp() As Variant

On Error Resume Next
  
ultimaLin = Sheets("DBTemp").Range("B" & Rows.Count).End(xlUp).Row
temp = Sheets("DBTemp").Range("B2:B" & ultimaLin).Value

For Each Value In temp
If Len(Value) > 0 Then area.Add Value, CStr(Value)
Next Value

For Each Value In area

autor_livro.AddItem Value

Next Value

Set area = Nothing

End Sub

如您所见，它们基本上是相同的，但在第二个中，我想在另一个范围内重现获得的结果。

谢谢！

标签： excelvba

解决方案

您可以将代码的公共部分分解为可重用的方法。

示例表单模块代码：

Private Sub UserForm_Initialize()
    With ThisWorkbook.Sheets("DBTemp")
        FillFromRange .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row), _
                      titulo_livro
    End With 
End Sub

在常规模块中：

Sub FillFromRange(rng As Range, ctrl As Object)
    Dim v
    For Each v In UniquesFromRange(rng)
        ctrl.AddItem v
    Next v
End Sub

Function UniquesFromRange(rng As Range)
    Dim col As New Collection, data, v
    data = rng.Value
    For Each v In data
        If Len(v) > 0 Then
            On Error Resume Next
            col.Add v, CStr(v)
            On Error GoTo 0
        End If
    Next v
    Set UniquesFromRange = col
End Function

推荐阅读