将Excel表宏处理为另一种格式。 删除重复项并重新格式化

Question

我的VBA旅程大约2个月，遇到一个无法在线解决的问题。 我在将Excel表转换为由我编程的另一个宏创建的另一种格式时遇到问题。 我有一张表格，在不同的行上有国家和一个数字的名称，在几行上列出了。 我希望它是动态的，因为此表每天都会更新

我在下面写了我想要的外观。 我的想法是将国家/地区编码为数字，然后删除国家/地区中的重复项。

我试图创建一个循环，但我想可能必须为每个国家/地区创建一个范围。

Sub ManipulateTable()
Dim Country as String
Dim USA as Range
Dim EU as Range
Dim India as Range

Const StartRow As Byte = 7
Dim LastRow as Long
LastRow = Range("A" & StartRow.(End(xlDown).Row

For i StartRow to LastRow 
Country = Range("A" & i).Value

If Country = "USA" Then Range("C" & i).value = 1
If Country = "EU" Then Range("C" & i).value = 2
If Country = "India" Then Range("C" & i).value = 3
Next i
' This to remove duplicates from column a
Range("A7:A30").RemoveDuplicates Columns:=Array(1). Header:= xlYes
' I thinking that I need to create a loop here 
' But I dont know where to start
For i StartRow to LastRow
Countryindex =  Range("C").Value
If Countryindex = 1 Then put under USA
If Countryindex = 2 Then put under EU

我的表格看起来像这样，带有单独的列

    "A" "B"
     Data
1    USA Sales
2    USA Employment Figures
3    USA Tax
4    EU Sales
5    EU Employment Figures
6    India Sales
7    India Expenses 
8    India Employment Figures

我想要一张看起来像这样的桌子

 "A" 
 Data
1    USA: (With some color)
2    Sales
3    Employment
4    Tax
5    EU: (With some color)  
6    Sales
7    Employment
8    India: (With some color)
9    Sales
10   Expenses
11   Employment

高度重视所有帮助。

Country Data Time

Country:
Data Time

Answer 1

保存副本，然后再运行此操作，它将覆盖您的数据。

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 ' an array would work but we can instr a string
                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