脚本字典以时间格式重新格式化Excel表

时间:2019-07-04 18:14:39

标签: excel vba dictionary formatting

两个月前,我开始了VBA之旅,但遇到了无法解决的问题。我有某种格式的表格,可以使用脚本字典重新格式化。

我试图添加另一个称为时间的变量,并用“ /”将其分隔。我担心的另一个问题是,时间列的格式为“ hh:mm”,尽管我相信,但可以在循环后重新进行设置。这是原始代码:

Dim lastrow As Long
Dim iter As Long
Dim diter As Long
Dim countrydict As Object
Dim country As String
Dim data As String
Dim key As Variant

Set countrydict = CreateObject("Scripting.Dictionary")

With ActiveSheet
    lastrow = .Cells(.Rows.Count, "A").End(xlUp).row

    For iter = 1 To lastrow
        country = Trim(.Cells(iter, 1).value)
        data = Trim(.Cells(iter, 2).value)
        If countrydict.Exists(country) Then
            If Not InStr(1, countrydict(country), data) > 0 Then 
          ' Remove  Dupes
       countrydict(country) = countrydict(country) & "|" & data 
            End If
        Else
            countrydict.Add country, data
        End If
    Next
    iter = 1
    For Each key In countrydict
        .Cells(iter, 1).value = key & ":"
        .cells(iter, 1).font.bold = True
        .cells(iter, 1).font.colorindex = 30
        iter = iter + 1
        For diter = 0 To UBound(Split(countrydict(key), "|"))
            .Cells(iter, 1).value = Split(countrydict(key), "|")(diter)
            iter = iter + 1
        Next
    Next
    .Columns("B").Clear
End With

这将从这种格式转换我的表格

 "A"   "B"
India Sales
France Sales
France Tax
Spain Sales
Spain Tax

进入

India: 
Sales
France:
Tax
Spain:
Sales
Tax 

这工作正常,但是我想知道如何添加“另一列”,所以如果我有这样的表

"A"   "B"   "C"
India Sales   12:00
France Sales  09:00
France Tax    11:00
Spain Sales   11:00
Spain Tax     05:00

我希望它看起来像这样

"A"   "B"     
India: 
Sales 12:00
France:
Sales 09:00
Tax   11:00
Spain:
Sales 11:00
Tax   05:00

我尝试添加

dim diter2 as Long
    For iter = 1 To lastrow
        country = Trim(.Cells(iter, 1).value)
        data = Trim(.Cells(iter, 2).value)
        time = Trim(.Cells(iter, 3).value)
        If countrydict.Exists(country) Then
            If Not InStr(1, countrydict(country), data) > 0 Then 

   countrydict(country) = countrydict(country) & "|" & data  & "/" & time
            End If
        Else
            countrydict.Add country, data, time
        End If
    Next
    iter = 1
    For Each key In countrydict
        .Cells(iter, 1).value = key & ":"
        .cells(iter, 1).font.bold = True
        .cells(iter, 1).font.colorindex = 30
        iter = iter + 1
        For diter = 0 To UBound(Split(countrydict(key), "|"))
            .Cells(iter, 1).value = Split(countrydict(key), "|")(diter)
            iter = iter + 1
           For diter2 = 0 To UBound(Split(countrydict(key), "|"))
            .Cells(iter, 2).value = Split(countrydict(key), "/")(diter2)
            iter = iter + 1    
            Next
        Next
    Next

非常感谢您的帮助

1 个答案:

答案 0 :(得分:0)

这应该更接近您想要的。您可以将时间复制为文本或值形式,并适当格式化接收方格。

   dim diter2 as Long, arr, arr2
    For iter = 1 To lastrow
        country = Trim(.Cells(iter, 1).value)
        data = Trim(.Cells(iter, 2).value)
        time = Trim(.Cells(iter, 3).Text) '<<<<<<
        If countrydict.Exists(country) Then
            If Not InStr(1, countrydict(country), data) > 0 Then 

                countrydict(country) = countrydict(country) & _
                                       "|" & data  & "/" & time
            End If
        Else
            countrydict.Add country, data  & "/" & time '<<<edit
        End If
    Next

    iter = 1
    For Each key In countrydict
        .Cells(iter, 1).value = key & ":"
        .cells(iter, 1).font.bold = True
        .cells(iter, 1).font.colorindex = 30
        iter = iter + 1
        arr = Split(countrydict(key), "|")
        For diter = 0 To UBound(arr)
            arr2 = Split(arr(diter), "/") 
            .Cells(iter, 1).value = arr2(0)
            .Cells(iter, 2).value = arr2(1)      
        Next diter
    Next key