Question

我想问一下如何缩短下面的代码？有没有其他方法可以达到相同的效果？

package.path = package.path .. ';../../libraries/testlibraries.lua;'

谢谢！

Answer 1

这是基于Dictionary的方法，应该适合您。

Public Sub RearrangeData()
    Dim objDic As Object
    Dim varRng
    Dim i As Long
    Set objDic = CreateObject("Scripting.Dictionary")
    objDic.CompareMode = vbTextCompare '\\ change this if you need it case sensitive
    varRng = Range("A2:B" & Range("A" & Rows.Count).End(xlUp).Row).Value
    For i = LBound(varRng) To UBound(varRng)
        If objDic.Exists(varRng(i, 1)) Then
            objDic.Item(varRng(i, 1)) = objDic.Item(varRng(i, 1)) & "/" & varRng(i, 2)
        Else
            objDic.Add varRng(i, 1), varRng(i, 2)
        End If
    Next i
    Range("A2:B" & Range("A" & Rows.Count).End(xlUp).Row).ClearContents
    Range("A2").Resize(objDic.Count, 1).Value = Application.Transpose(objDic.Keys)
    Range("B2").Resize(objDic.Count, 1).Value = Application.Transpose(objDic.Items)
    Set objDic = Nothing
End Sub

Answer 2

这是另一种字典方法（不需要参考添加）

Sub strings()
    Dim data As Variant, key As Variant
    Dim i As Long

    data = Range("B2", Cells(Rows.Count, 1).End(xlUp)).Value

    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(data)
            .Item(data(i, 1)) = .Item(data(i, 1)) & "/" & data(i, 2)
        Next
        Range("A1").CurrentRegion.Resize(Range("A1").CurrentRegion.Rows.Count - 1).Offset(1).ClearContents

        i = 1
        For Each key In .Keys
            i = i + 1
            Cells(i, 1) = key
            Cells(i, 2) = Mid(.Item(key), 2)
        Next
    End With
End Sub

BTW ，如果您曾需要合并来自更多列的字符串，您可以使用

Option Explicit

Sub strings()
    Dim data As Variant, key As Variant
    Dim i As Long, iCol As Long

    With Range("A1").CurrentRegion
        With .Resize(.Rows.Count - 1).Offset(1)
            data = .Value
            .ClearContents
        End With
    End With

    With CreateObject("Scripting.Dictionary")
        For iCol = 2 To UBound(data, 2)
            For i = 1 To UBound(data)
                .Item(data(i, 1)) = Trim(.Item(data(i, 1)) & " " & data(i, iCol))
            Next
            Range("A2").Resize(.Count) = Application.Transpose(.Keys)
            Range("A2").Resize(.Count).Offset(, iCol - 1) = Application.Transpose(.Items)
            .RemoveAll
        Next
    End With
    Range("a1").CurrentRegion.Replace what:=" ", replacement:="/", lookat:=xlPart
End Sub

有没有其他方法来组合相同项目的字符串？

2 个答案: