将 Excel table 宏操作为另一种格式。删除重复项并重新格式化

Question

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

我在下面写了我想要它的样子。我的想法是将国家编码为数字，然后删除国家区域中的重复项。

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

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

我的 Table 看起来像这样，有单独的列

    "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

我想要一个看起来像这样的table

 "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

将 Excel table 宏操作为另一种格式。删除重复项并重新格式化

Manipulate Excel table macro to another format. Remove duplicates and reformat

excel

vba

string

manipulate