Question

这是原始数据。

这是数据应该是什么样子但由于下面列出的原因而不胜。

我遇到的问题是，有时数据集中缺少整个标题和数据值，因此使用脚本中的最后一行将数据向上移动一个。例如，如果我在sheet1上完全删除了H11：H12，然后与A11：K11中的数据集关联的H列的值实际上来自数据集A13：K13（或单元格值H14）。

如果相应的标题不存在，则第二张图片中显示的空格不会出现。

问题：给出以下代码;您是否认为可以将数据与标题匹配，并将原始偏移行号与其在第2页上匹配的列一起使用并将值粘贴到那里？相反，当前的代码（唯一有效的方法是查找最后一行）。

实例/思想： 我认为脚本必须占用一个单元格（例如D9并识别它是D和偏移以选择D10并将D9记录与第2页D列相匹配并将D10数据粘贴到D10而不是D5中

第二个例子，Script取I17并识别它与I匹配第2列I列然后偏移以选择/复制并粘贴I18中的I19数据而不是I9。

Sub main()
    Dim hedaerCell As Range
    Dim labelsArray As Variant

    With ThisWorkbook.Worksheets("Sheet2") '<--| reference your "headers" worksheet
        For Each hedaerCell In .Range("A1:K1") '<--| loop through all "headers"
            labelsArray = GetValues(hedaerCell.Value) '<--| fill array with all labels found under current "header"
            .Cells(.Rows.Count, hedaerCell.Column).End(xlUp).Offset(1).Resize(UBound(labelsArray)).Value = Application.Transpose(labelsArray)
            Next
    End With
End Sub

Function GetValues(header As String) As Variant
    Dim f As Range
    Dim firstAddress As String
    Dim iFound As Long

    With ThisWorkbook.Worksheets("Sheet1").UsedRange '<--| reference your "data" worksheet
        ReDim labelsArray(1 To WorksheetFunction.CountIf(.Cells, header)) As Variant '<--| size an array to store as many "labels" as passed 'header' occurrences
        Set f = .Find(what:=header, LookIn:=xlValues, lookat:=xlWhole) '<--| start seraching for passed 'header'
        If Not f Is Nothing Then
            firstAddress = f.Address
            Do
                iFound = iFound + 1
                labelsArray(iFound) = f.Offset(1)
                Set f = .FindNext(f)
            Loop While f.Address <> firstAddress
        End If
    End With
    GetValues = labelsArray
End Function

照片中的数据不是实际数据，而只是占位符。 A到K表示类别标题。任何数字或特殊字符表示在每个类别下收集的数据。您可能会注意到某些类别没有特定数据集的值（行号）。我无法找到将空白单元格复制到第二张纸的方法。相反，在当前的代码下，它只是忽略了任何空白。

我在想，如果有任何人知道可以帮助我将数据与相应的标题匹配以找到要粘贴的正确列但仍保留原始数据表中的原始行号，那么它将解决问题代码无法复制空白单元格并将各个数据集保持在一起。

**更新：**我创建了一个示例文档的链接。 https://www.dropbox.com/s/03p8n1u9y9nvbd5/Example.xlsm?dl=0

VBA数据排序和格式

0 个答案: