工作杂记4

今天将Excel中某个表格的数据处理后输出到Excel另一个位置，临时代码如下：

Sub 按钮1_Click()
    Dim dict, temp, name, k, v, n, ks, vs
    Set dict = CreateObject("Scripting.Dictionary")
    Dim r As Range
    Dim r2 As Range
    Dim r3 As Range
    Dim row As ListRow
    Dim rows As ListRows
    Set rows = Sheet3.ListObjects("表6").ListRows
    Dim i As Integer
    
    For i = 1 To rows.Count
        Set row = rows.Item(i)
        Set r = row.Range.Cells(1, 3)
        Set r2 = row.Range.Cells(1, 4)
        Set r3 = row.Range.Cells(1, 2)
        If r.Text <> "" Then
            temp = Replace(r.Text, "-", "+")
            name = Replace(r2.Text, "-", "+")
            k = Split(temp, "+")
            v = Split(name, "+")
            For n = LBound(k) To UBound(k)
                If Not dict.exists(Mid(Trim(k(n)), 2, Len(Trim(k(n))) - 2)) Then
                    dict.Add Mid(Trim(k(n)), 2, Len(Trim(k(n))) - 2), Trim(v(n) + "||||" + Trim(r3.Text))
                Else
                    dict.Item(Mid(Trim(k(n)), 2, Len(Trim(k(n))) - 2)) = Trim(v(n) + "||||" + Trim(r3.Text))
                End If
            Next
        End If
    Next i
    'MsgBox dict.Count
    Sheet3.Range("H1", "J100").Clear
    ks = dict.keys
    vs = dict.Items
    For i = 0 To dict.Count - 1
        Key = ks(i)
        Value = vs(i)
        Sheet3.Range("H" & (i + 16)).Select
        ActiveCell.FormulaR1C1 = Key
        Sheet3.Range("I" & (i + 16)).Select
        ActiveCell.FormulaR1C1 = Split(Value, "||||")(1)
        Sheet3.Range("J" & (i + 16)).Select
        ActiveCell.FormulaR1C1 = Split(Value, "||||")(0)
        
        'MsgBox Key & Value
    Next
    
    Set r = Nothing
    Set r2 = Nothing
    Set row = Nothing
    Set rows = Nothing
    Set dict = Nothing
  
End Sub

VBA中Dictionary对象使用小结

Dim dict

' 创建Dictionary
Set dict = CreateObject("Scripting.Dictionary")

' 增加项目
dict.Add "A", 300
dict.Add "B", 400
dict.Add "C", 500

' 统计项目数
n = dict.Count

' 删除项目
dict.Remove ("A")

' 判断字典中是否包含关键字
dict.exists ("B")

' 取关键字对应的值，注意在使用前需要判断是否存在key，否则dict中会多出一条记录
Value = dict.Item("B")

' 修改关键字对应的值,如不存在则创建新的项目
dict.Item("B") = 1000
dict.Item("D") = 800

' 对字典进行循环
k = dict.keys
v = dict.Items
For i = 0 To dict.Count - 1
key = k(i)
Value = v(i)
MsgBox key & Value
Next

' 删除所有项目

dict.Removeall

实例：

Sub 宏1()

Set dic = CreateObject("Scripting.Dictionary") '字典
For i = 1 To 10000
If Not i Like "*4*" Then
dic.Add i, "" '如果不包含“1”
End If
Next
Range("a2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.keys) '从A2单元开始向下放置
End Sub

 

 

 

=========================================================================

又 Tranpose工作表函数的用法实例

 

'把一行多列的二维数组转换成一维数组

Sub test()
Dim arr, arrt
arr = Range("a1:j1")
arrt = WorksheetFunction.Transpose(WorksheetFunction.Transpose(arr))
Stop
End Sub

首先看看TRANSPOSE函数的基础用法。官方帮助说明，TRANSPOSE函数可返回转置单元格区域，即将行单元格区域转置成列单元格区域，反之亦然。

　　TRANSPOSE函数语法是：TRANSPOSE(array)

　　Array参数是需要进行转置的数组或工作表上的单元格区域。所谓数组的转置就是，将数组的第一行作为新数组的第一列，数组的第二行作为新数组的第二列，以此类推。