匹配列与参考列并添加空行以匹配

时间:2015-07-07 01:40:39

标签: excel vba excel-vba

我获得了一个数据集,该数据集使输出变平,这样如果条目为0,则完全删除该行。具体而言,每行中具有非零值的完整数据集将具有第一列

a
b
c
d
e

但是数据集的条目b和d的值为0,它将具有第一列

a
c
e

我需要将完整集中的引用列与数据集的第一列相匹配,并添加空行以使行号匹配。所需的输出是

a    
b

d

e

我编写了一些代码,这些代码在行中递归添加,但它添加的行数超出了我的预期。

Public Sub AddBlankRows(referenceColumn As Range, targetColumn As Range)
Dim referenceArray() As Variant
Dim workingArray() As Variant
Dim referenceColumnLength As Long
Dim arrayIndex As Long


referenceArray = referenceColumn
workingArray = targetColumn
referenceColumnLength = UBound(referenceArray, 1)

For arrayIndex = 1 To referenceColumnLength
    If referenceArray(arrayIndex, 1) <> workingArray(arrayIndex, 1) Then
        If workingArray(arrayIndex, 1) <> vbNullString Then
            ActiveSheet.Rows(arrayIndex).EntireRow.Insert
            AddBlankRows referenceColumn, targetColumn
        End If
    End If
Next arrayIndex


End Sub

Public Sub TESTAddBlankRows()

Dim ws As Worksheet
Dim referenceWS As Worksheet

Set ws = Sheets("Sheet1")
Set referenceWS = Sheets("Sheets2")

'referenceWS.Range("A1:A5") is (a, b, c, d, e)^T
'ws.Range("A1:A5") is (a,c,d,e,"")^T

AddBlankRows referenceWS.Range("A1:A5"), ws.Range("A1:A5")


End Sub

0 个答案:

没有答案