求助：如何按要求提取数据（字典）

frank7863

求助问题说明，附件中初始表格是原始数据，转化格式中黄色高亮的字母代表数据来自初始表格的哪一列，如Y代表初始表格的Y列，TBD为待定空白，完成表格是完成后的样子。
希望的效果是转化格式中增加一个控件,选中后可导入初始表格，再导出完成表格。
正式数据每个都在500行左右，是否用字典写会加快处理速度。
学习VBA中，可以看懂部分代码，刚开始学习字典，对字典的循环逻辑还不能理解，可能的话在代码中给一些注解，方便学习，谢谢。

蓝桥玄霜

500行数据不多，也不是一定需要用字典，普通循环判断即可。
只是结果表中显示的似乎有与你的要求不相符的：如CA不是US的也有，不是FedEx Ground的也有；

frank7863

老师，我现在用普通的方式写了一个满足需求的，能帮忙看看可以优化的地方，谢谢

Sub 转换()
' 快捷键: Ctrl+a
Dim a As Workbook, b, sht As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
b = Application.GetOpenFilename("Excel 文件 ,*.csv*")
If b = False Then MsgBox "你没有选择文件"
Set a = Workbooks.Open(b)
a.Worksheets(1).Cells.Copy ThisWorkbook.Worksheets("数据").[a1]
a.Close False

Dim arr, pos, i, j
pos = Array(25, 26, 27, 28, 29, 30, 31)
With Sheets("数据")
arr = .Range("A2:AP" & .Cells(Rows.Count, 1).End(xlUp).Row)
End With
For i = 1 To UBound(arr, 1)
    arr(i, 1) = ""
    arr(i, 2) = arr(i, pos(0))
    arr(i, 3) = arr(i, pos(0))
    arr(i, 4) = arr(i, pos(1))
    arr(i, 5) = arr(i, pos(2))
    arr(i, 6) = arr(i, pos(3))
    arr(i, 7) = arr(i, pos(4))
    arr(i, 8) = arr(i, pos(5))
    arr(i, 9) = "US"
    arr(i, 10) = arr(i, pos(6))
    arr(i, 11) = ""
    arr(i, 12) = ""
    arr(i, 13) = ""
    arr(i, 14) = "92"
    arr(i, 15) = "1"
    arr(i, 16) = ""
    arr(i, 17) = "3"
    arr(i, 18) = ""
    arr(i, 19) = ""
    arr(i, 20) = ""
    arr(i, 21) = ""
    arr(i, 22) = ""
    arr(i, 23) = ""
    arr(i, 24) = ""
    arr(i, 25) = arr(i, pos(0))
    arr(i, 26) = ""
    arr(i, 27) = ""
    arr(i, 28) = ""
    arr(i, 29) = ""
    arr(i, 30) = ""
    arr(i, 31) = ""
    arr(i, 32) = ""
    arr(i, 33) = ""
    arr(i, 34) = ""
    arr(i, 35) = "1"
    arr(i, 36) = ""
Next i
With Sheets("结果")
.[a2].Resize(UBound(arr, 1), 36) = arr
End With
Sheets("结果").Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\数据" & ".xlsx", FileFormat:=xlWorkbookDefault
End Sub