Excel VBA来填充工作表

源数据表

待填充的数据表

我有两张表，源表和需要填充数据的表

我想从另一张表的相应列下的源表中获取数值

我试过这个

我试图用我的代码添加它，但它出了问题，请你检查一下。考虑到我的数据已经格式化为

Sub pop_codes() '
    Dim wsdata, wsPop As Worksheet
    Dim lngLoop1 As Long
    Dim lngLoop2 As Long
    Dim aData() As String
    Dim strData As String
    Dim DataLastRow As Integer
    Dim DataLastCol As Integer
    Set wsdata = Sheets("SourceData")
    Set wsPop = Sheets("TempData")
    DataLastRow = wsdata.Cells(wsdata.Rows.Count, "A").End(xlUp).Row
    DataLastCol = wsdata.Cells(1, wsdata.Columns.Count).End(xlToLeft).Column

    OutputRow = 2
    SearchArr = Array("AV", "CS", "P", "X", "FW", "H", "J", "L", "M", "N", "P", "PD", "PK", "R", "S", "T", "V", "W", "X", "BK", "CP", "FX", "HD", "IP", "IU")
    For OutputRow = 2 To DataLastRow
        For OutputCol = 2 To DataLastCol
           strData = wsdata.Cells(OutputRow, OutputCol)
           ' strData = Replace(strData, ")", ",")
           ' strData = Replace(strData, "(", ",")
           'strData = Replace(strData, " ", "")
            aData() = Split(strData, ",")
            For lngLoop1 = LBound(aData, 1) To UBound(aData, 1)
                For lngLoop2 = LBound(SearchArr) To UBound(SearchArr)
                    If InStr(aData(lngLoop1), SearchArr(lngLoop2)) > 0 Then
                        wsPop.Cells(OutputRow, 1) = wsdata.Cells(OutputRow, 1)
                        wsPop.Cells(OutputRow, 2) = wsdata.Cells(1, DataLastCol)
                        wsPop.Cells(OutputRow, 3) = SearchArr(lngLoop2)
                        wsPop.Cells(OutputRow, 4) = Replace(aData(lngLoop1), SearchArr(lngLoop2), "")
                        OutputRow = OutputRow + 1
                    End If
                Next lngLoop2
            Next lngLoop1
        Next OutputCol
    Next OutputRow
sExit:
    On Error Resume Next
    Set wbData = Nothing
    Set wsPop = Nothing
    Exit Sub
E_Handle:
    MsgBox Err.Description & vbCrLf & vbCrLf & "sDataSource", vbOKOnly + vbCritical, "Error: " & Err.Number
    Resume sExit
End Sub

---

对于如此复杂的任务，没有简单的解决方案

如果我是你，我会先把它分成不同的页面：一个页面，包含AV结果，一个包含CS结果

您还需要找到一种读取单元格内容的方法，我看到需要做以下事情：

删除所有AVO和所有单元格，至少这是我理解任务的方式 区分包含逗号的单元格和不使用数组存储带逗号单元格值的单元格 在读取单元格内容时，请注意有时显示40 AV，有时不是40 CS的空间

---

一旦您将所有内容拆分为不同的页面并检查其正确性，您可以将所有内容汇总为一个页面。

我将使用一个单步工作表，我将使用第一个工作表中的拆分数据填充该工作表。然后可以将其用作最终工作表的基础

执行此操作的某些VBA代码可能是：

Sub sDataSource()
    On Error GoTo E_Handle
    Dim wsIn As Worksheet
    Dim lngInLastRow As Long
    Dim lngInLastCol As Long
    Dim wsOut As Worksheet
    Dim strData As String
    Dim aData() As String
    Dim aSearch() As Variant
    Dim lngLoop1 As Long
    Dim lngLoop2 As Long
    Dim lngOutRow As Long
    Dim lngInRow As Long
    Dim lngInCol As Long
    Set wsIn = Worksheets("SourceData")
    lngInLastRow = wsIn.Cells(wsIn.Rows.Count, "A").End(xlUp).Row
    lngInLastCol = wsIn.Cells(1, wsIn.Columns.Count).End(xlToLeft).Column
    Set wsOut = Worksheets("TempData")
    lngOutRow = 2
    aSearch = Array("AV", "BK", "CP", "CS", "FW", "FX", "HD", "IP", "IU", "PD", "PK", "P", "H", "J", "L", "M", "N", "R", "S", "T", "V", "W", "X")
    For lngInRow = 2 To lngInLastRow
        For lngInCol = 2 To lngInLastCol
            strData = wsIn.Cells(lngInRow, lngInCol)
            strData = Replace(strData, ")", ",")
            strData = Replace(strData, "(", ",")
            strData = Replace(strData, " ", "")
            aData() = Split(strData, ",")
            For lngLoop1 = LBound(aData, 1) To UBound(aData, 1)
                For lngLoop2 = LBound(aSearch) To UBound(aSearch)
                    If InStr(aData(lngLoop1), aSearch(lngLoop2)) > 0 Then
                        wsOut.Cells(lngOutRow, 1) = wsIn.Cells(lngInRow, 1)
                        wsOut.Cells(lngOutRow, 2) = wsIn.Cells(1, lngInCol)
                        wsOut.Cells(lngOutRow, 3) = aSearch(lngLoop2)
                        wsOut.Cells(lngOutRow, 4) = Replace(aData(lngLoop1), aSearch(lngLoop2), "")
                        aData(lngLoop1) = ""
                        lngOutRow = lngOutRow + 1
                    End If
                Next lngLoop2
            Next lngLoop1
        Next lngInCol
    Next lngInRow
sExit:
    On Error Resume Next
    Set wsIn = Nothing
    Set wsOut = Nothing
    Exit Sub
E_Handle:
    MsgBox Err.Description & vbCrLf & vbCrLf & "sDataSource", vbOKOnly + vbCritical, "Error: " & Err.Number
    Resume sExit
End Sub

在这段代码中，我循环了工作表，得到了每周/用户的值。我已将括号替换为逗号，并删除了所有空格。然后将其拆分为一个数组，然后我遍历该数组，检查每个不同的值，即我要查找的CS、P、AV、X。如果找到它，则输出数组的这个元素，用空字符串替换文本部分

对代码进行了修改，以处理某些数据名在使用InStr时可能导致重复的事实，即p和CP，我通过将两个字符的数据名放在数组的开头来处理这一问题，如果存在匹配项，则将数据数组的元素设置为零长度字符串

---

关于，

为什么第3周和第3周有40英寸待填充表abc@gmail@com？在sourcce数据表上，它说abc@gmail.com第三周：AV040CS。这不意味着AV是0吗？请在待填充表中填写剩余的空单元格，以明确结果。在将部分代码复制到您的代码中之前，请实际阅读我的代码并了解其工作原理。因为您只复制了它的一部分，所以它不能正常工作-例如，您使用OutputRow作为数据表上的循环计数器和临时表的行号。此外，还需要替换函数将数据转换为可以很好地拆分为数组的格式，因此AV025CS，15P变成AV0，25CS，15P，@Applecore我已经按照u所述的格式拆分了数据，预先填充week和name。我只是想为数组添加条件，以及如何将它们填充到各自的列中。我提供的代码是拆分到临时工作表中，解析出不同名称的值-然后需要额外的代码填充最终的工作表。@Applecore在u给出的代码中是否有一个通用代码。我可以使用该代码来使用这些搜索值并填充到列中？考虑到我的数据已被格式化，我尝试了您的代码并在问题中对其进行了更新，。你能检查数组并相应地调整代码吗。最多一个单元格可以有5个代码。谢谢tonsI，我修改了我的代码来处理P/PX/CP，在这3种情况下都可以找到P。谢谢，代码总是在上面的代码中。我应该如何添加其他大小写，如S、T、V、W，它们是列，它们的代码应该填充在其中？？将它们添加到数组aSearch中，确保任何单个字符的名称都位于数组的末尾，我想把搜索项填充到它们对应的列中，它们与u给出的序列相同。