VBA (Excel Maros) 的各种问题

如何解决VBA (Excel Maros) 的各种问题

我想从几天前我从未接触过 VBA 开始，更不用说 excel 宏了。

我需要将 1000 行（4 列）的数据从一张工作表（工作表 1）传输并转换到另一张工作表（工作表 2）。

快速描述我得到的内容，每一行都是一个对象，我有 4 列。第一个（列）是对象 ID，第二个是对象名称，第三个解释对象的内容，最后一列解释如何。这是一个非常简化的版本，因为解释整个项目会很复杂。

在第二张纸上，我有 6000 行，所有行都包含对象的 ID 和名称，但缺少内容和方式。

我的目标是从该工作表中获取对象的内容和方式，将措辞转换为第二张工作表接受的形式，并确保将其添加到正确的 ID 中。

我尝试了在网上找到的多个代码示例来尝试选择并将第一张表中的信息组织到表格（数组）中，但我失败了。

转换内容和方式

第二张纸的格式非常严格，所有内容都可以写入。在我看来（Lua 是我的主要语言），我会有一个字典或表格，其中包含所有可能的方式/内容可以写在第一张纸上，并检查每一个以查看它们是否匹配，然后将其更改为相应的工作表2 格式。让我演示给你看。（这就是什么。我将在下面展示另一个表格）

local MType = {
    ["Industrial"] = {"MILPRO : Industrial","Industrial"};
    ["Public Saftey"] = {"MILPRO : Public Saftey","Public Saftey"};
    ["Military"] = {"MILPRO : Military","Military"};
    ["Paddling"] = {"Recreation : Paddling","Paddling"};
    ["Sporting Goods"] = {"Recreation : Sporting Goods","Sporting Goods"};
    ["Outdoor"] = {"Recreation : Outdoor","Outdoor"};
    ["Hook & Bullet"] = {"Recreation : Hook & Bullet","Hook & Bullet"};
    ["Marine"] = {"Recreation : Marine","Marine","Marina / Lodge"};
    ["Sailing"] = {"Recreation : Sailing","Sailing"};
    ["UnkNown"] = {"UNKNowN"}
}

local CType = {
    ["Multi-Door"] = {"Multi-Door","Multi-door"};
    ["Dealer & distributor"] = {"distributor","Dealer & distributor"};
    ["Independant Specialty"] = {"Independant Specialty","Specialty"};
    ["OEM"] = {"OEM","OEM - VAR"};
    ["Internal"] = {"Internal","Sales Agency","Repairs Facility"};
    ["Rental"] = {"Rental / Outfitter","Rental"};
    ["End User"] = {"End User"};
    ["Institution"] = {"Institution","Government Direct"};
    ["UnkNown"] = {"UNKNowN"}
}

每个表格中的第一个位置（表格 = 大括号）是第二个工作表接受的格式。表格中的其余部分是它们在第一张纸中的书写方式。（这就是我想象的结果。了解 VBA 的功能和限制）

将信息与正确的 ID 匹配

每个对象都有一个长度为 6 个字符的 ID，范围从 000100 到 999999。从第一张纸中获取信息时，我需要确保将其放回第二张纸中具有正确 ID 的行中（注意有 1000 行在第一张纸上和 6000 在第二张纸上）。

最后说明：ID 存储为文本而不是数字（如果需要更改 lmk）。两个工作表的信息都在表格中。我可能会将这种方法用于其他类似的工作表 1。任何失败的转换（关于内容和方式）都应标记为未知。

两张纸的视觉表现

Sheet 1 Format

Sheet 2 format

解决方法

我们可以创建一个二维数组来保存一个字典的所有对，然后使用 For..Next 循环检查每个元素。

Sub transcribe()

On Error GoTo Handler

Application.ScreenUpdating = False

Dim WS1 As Worksheet,WS2 As Worksheet
Dim ID1 As Range,ID2 As Range
'This is assuming youre working in Sheets 1 and 2
Set WS1 = Sheets(1)
Set WS2 = Sheets(2)
'This is assuming your tables are in these locations
Set ID1 = WS1.Range(WS1.Cells(1,1),WS1.Cells(10,1))
Set ID2 = WS2.Range(WS2.Cells(1,WS2.Cells(20,1))

Dim cellx As Range
Dim rowID1 As Integer
Dim FieldA As String,FieldB As String
Dim IDfound As Boolean
IDfound = True

Dim arrayA(1 To 10,1) As String
    arrayA(1,0) = "MILPRO : Industrial"
    arrayA(1,1) = "Industrial"
    arrayA(2,0) = "MILPRO : Public Saftey"
    arrayA(2,1) = "Public Saftey"
    '... etc. You have to complete this array with all the pairs of your dictionary of Field A
    'array(X,1) holds what you expect to find in table 1,and array(X,0) holds what you want to write down in table 2.

Dim arrayB(1 To 9,1) As String
    arrayB(1,0) = "Multi-Door"
    arrayB(1,1) = "Multi-Door"
    arrayB(2,0) = "Distribuitor"
    arrayB(2,1) = "Dealer & Distribuitor"
    '... etc. You have to complete this array with all the pairs of your dictionary of Field B
    'array(X,0) holds what you want to write down in table 2.


'Now we sweep each cell in Table 2
For Each cellx In ID2.Cells
    'And we search its ID for a match in Table 1.
    rowID1 = Application.Match(cellx.Value,ID1,0)
    
    If IDfound = True Then
        'We then write down the values of Field A and B in the found row
        FieldA = ID1.Resize(1).Offset(rowID1 - 1,2).Value
        FieldB = ID1.Resize(1).Offset(rowID1 - 1,3).Value
        'And we call a function (see below) to correct their values
        cellx.Offset(0,2).Value = corrected(FieldA,arrayA,10)
        cellx.Offset(0,3).Value = corrected(FieldB,arrayB,9)
    Else
        cellx.Offset(0,2).Value = "ID not found"
        cellx.Offset(0,3).Value = "ID not found"
        IDfound = True
    End If
    
Next

Application.ScreenUpdating = True
Exit Sub

Handler:
    IDfound = False
    Resume Next

End Sub
Function corrected(Field As String,arrayX As Variant,UB As Integer) As String
'This is the dictionary-like function
Dim found As Boolean
'We sweep each element in the dictionary array until we find a match
For i = 1 To UB
    If Field = arrayX(i,1) Then
        corrected = arrayX(i,0)
        found = True
        Exit Function
        Exit For
    End If
Next
'If no match was found,we will write that down in the result
If found = False Then
    corrected = Field & " - Not found in dictionary"
    Exit Function
End If

'This code should never be reached,its just for foolproofing
corrected = "Error"

End Function

VBA (Excel Maros) 的各种问题

如何解决VBA (Excel Maros) 的各种问题

解决方法

相关推荐