根据条件在多列中上下填充单元格

时间:2015-04-28 10:39:42

标签: excel vba excel-vba

我有以下列和值:

Begin Time  Other values    First Name  Last Name   other info
5041*       value1                                  info1
5041*       value2          firstname1  lastname1   info2
13089       value3                                  info3
16130       value4                                  info4
19739       value5                                  info5
26300       value6                                  info6
26391*      value7          firstname2  lastname2   info7
27878       value8                                  info8
27878       value9                                  info9
28234       value10                                 info10
28738       value11                                 info11
29854       value12                                 info12
63110       value13                                 info13
63189*      value14         firstname3  lastname3   info14
64335       value15                                 info15
65423       value16                                 info16
72089*      value17                                 info17
72089*      value18         firstname4  lastname4   info18
73495       value19                                 info19
73495       value20                                 info20
74330       value21                                 info21
74877       value22                                 info22
76710       value23                                 info23
82599*      value24                                 info24
82599*      value25          firstname5 lastname5   info25
86712*      value26                                 info26
98712*      value27          firstname6 lastname6   info27
98725       value28                                 info28
100605      value29                                 info29
100605      value30                                 info30
100954      value31                                 info31


我希望如此:

Begin Time  Other values    First Name  Last Name   other info
5041        value1          firstname1  lastname1   info1
5041        value2          firstname1  lastname1   info2
13089       value3          firstname1  lastname1   info3
16130       value4          firstname1  lastname1   info4
19739       value5          firstname1  lastname1   info5
26300       value6          firstname1  lastname1   info6
26391       value7          firstname2  lastname2   info7
27878       value8          firstname2  lastname2   info8
27878       value9          firstname2  lastname2   info9
28234       value10         firstname2  lastname2   info10
28738       value11         firstname2  lastname2   info11
29854       value12         firstname2  lastname2   info12
63110       value13         firstname2  lastname2   info13
63189       value14         firstname3  lastname3   info14
64335       value15         firstname3  lastname3   info15
65423       value16         firstname3  lastname3   info16
72089       value17         firstname4  lastname4   info17
72089       value18         firstname4  lastname4   info18
73495       value19         firstname4  lastname4   info19
73495       value20         firstname4  lastname4   info20
74330       value21         firstname4  lastname4   info21
74877       value22         firstname4  lastname4   info22
76710       value23         firstname4  lastname4   info23
82599       value24         firstname5  lastname5   info24
82599       value25         firstname5  lastname5   info25
86712       value26         firstname6  lastname6   info26
98712       value27         firstname6  lastname6   info27
98725       value28         firstname6  lastname6   info28
100605      value29         firstname6  lastname6   info29
100605      value30         firstname6  lastname6   info30
100954      value31         firstname6  lastname6   info31


感谢http://symfony.com/blog/new-in-symfony-2-6-smarter-assets-install-command

,我正在使用以下代码
Sub FillColBlanksSpecial()

Dim wks As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim LastRow As Long
Dim col As Long
Dim lRows As Long
Dim lLimit As Long

Dim lCount As Long
On Error Resume Next

lRows = 2
lLimit = 1000

Set wks = ActiveSheet
 For Each wks In Worksheets
        If Right(wks.Name, 2) = "-A" Or Right(wks.Name, 2) = "-B" Then
            With wks
                With .Cells(1, 1).CurrentRegion
                    With .Columns("C:D")
                        If CBool(Application.CountBlank(.Cells)) Then
                            .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=r[-1]c"
                        End If
                    End With
                    'un comment the next line if you want the formulas to revert to values only
                    .Cells = .Cells.Value
                End With
            End With
        End If
    Next wks
End Sub


目标是填写列C&中的值。 D ,直到工作表中的下一个值,其中 -A -B 后缀为工作表名称。

但是

正如您在示例数据中看到的那样,我希望此填充考虑到第一列中的代码。 例如:在 A2 & A3 代码 5041 ,因此我想填充 第2行中的值C3 D3 (即 firstname1 & lastname1 ),然后填写相同的值,直到下一次出现的值为止列C& D (即 firstname2 & lastname2 )或有时在下一次出现之前的一行,因为一行与A列共享相同的代码。后一个例子就是填写 firstname3 & lastname3 直到 firstname4 &发生之前的一行 lastname4 因为该行与列A 中的相同代码与以下 firstname4 & lastname4 将由 firstname4 &amp ;; 填充 lastname4 轮流。

如何修改此vba代码以适应这种情况?

@Jeeped's answer

P.S。第一栏中的代码旁边的星号标记仅用于视觉可访问性;否则它们不会出现在原始数据表中。

1 个答案:

答案 0 :(得分:3)

你将不得不填写一个更复杂的公式。此外,由于此公式在确定默认值之前会向上和向下查看,因此公式必须解析为其返回值,然后才能继续执行下一个空白单元格,以便在将来的查找中使用该值没有引起循环引用。

Sub FillColBlanksSpecial2()

    Dim wks As Worksheet
    Dim rng As Range
    Dim rng2 As Range
    Dim blnk As Range
    Dim LastRow As Long
    Dim col As Long
    Dim lRows As Long
    Dim lLimit As Long

    Dim lCount As Long
    On Error Resume Next

    lRows = 2
    lLimit = 1000

    Set wks = ActiveSheet
    For Each wks In Worksheets
        If Right(wks.Name, 2) = "-A" Or Right(wks.Name, 2) = "-B" Then
            With wks
                With .Cells(1, 1).CurrentRegion
                    With .Columns("C:D")
                        If CBool(Application.CountBlank(.Cells)) Then
                            For Each blnk In .SpecialCells(xlCellTypeBlanks)
                                blnk.FormulaR1C1 = "=if(countifs(r1c1:r[-1]c1, rc1, r1c:r[-1]c, ""<>""), index(r1c:r[-1]c, match(rc1, r1c1:r[-1]c1, 0)), if(countifs(r[1]c1:r9999c1, rc1, r[1]c:r9999c, ""<>""), index(r[1]c:r9999c, match(rc1, r[1]c1:r9999c1, 0)), r[-1]c))"
                                blnk.Value = blnk.Value
                            Next blnk
                        End If
                    End With
                End With
            End With
        End If
    Next wks
End Sub

xlR1C1和xlA1中的新公式(如C2所示)是,

=IF(COUNTIFS(R1C1:R[-1]C1, RC1, R1C:R[-1]C, "<>"), INDEX(R1C:R[-1]C, MATCH(RC1, R1C1:R[-1]C1, 0)), IF(COUNTIFS(R[1]C1:R9999C1, RC1, R[1]C:R9999C, "<>"), INDEX(R[1]C:R9999C, MATCH(RC1, R[1]C1:R9999C1, 0)), R[-1]C))
=IF(COUNTIFS($A$1:$A1, $A2, C$1:C1, "<>"), INDEX(C$1:C1, MATCH($A2, $A$1:$A1, 0)), IF(COUNTIFS($A3:$A$9999, $A2, C3:C$9999, "<>"), INDEX(C3:C$9999, MATCH($A2, $A3:$A$9999, 0)), C1))
  • 该公式首先查看其上方A列中是否存在非空名字的值,如果有,则接受并继续。
  • 如果找不到高于它的值,则会在其下方查找名字不为空的匹配项。如果找到,它会接受并继续前进。
  • 如果未找到,则接受默认值正上方的值。

如果您遵循该逻辑,您可以看到公式可以立即恢复为值,或者后续公式可以将其作为公式找到并创建循环引用。这有点慢,因为它循环遍历xlCellTypeBlanks而不是在块中推送公式和值,但它是彻底的。