Question

源数据表

要填充的数据表

我有两张纸作为数据源和需要填充数据的纸。

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

我尝试过

我尝试添加代码，但是在某处出错了，请检查一下。考虑到我的数据已经用格式化了。

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

Answer 1

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

一些执行此操作的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”），我已经通过放置两个字符数据名称来解决了这一问题。在数组的开头，如果有匹配项，则将数据数组的元素设置为长度为零的字符串。

此致

Answer 2

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

如果我是您，我首先将其分成不同的页面：一页包含AV结果，一页包含CS结果，...

您还需要找到一种读取单元格内容的方法，我认为需要完成以下工作：

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

将所有内容解密到不同的页面（并检查正确性）后，您可以将所有内容汇总到一页。

VBA填充工作表

2 个答案: