在Excel中循环遍历带有条件的列[重复]答案

【问题标题】：Loop through columns with conditional if in Excel [duplicate]在Excel中循环遍历带有条件的列[重复]
【发布时间】：2014-08-25 17:59:06
【问题描述】：

我需要编写一个 excel 脚本来填写一些数据。基本上需要发生的是脚本应该遍历每条记录，当它到达“1”时，它应该在每个单元格后面跟着另一个“1”，直到它到达下一个“1”。我的目标是用更多的 1 来填补 1 之间的空白。

这是我目前所拥有的：

Dim i, j As Integer

finalrow = Cells(665, 1).End(x1up).Row
finalcol = Cells(1, 10).End(x1toleft).Column

For i = 1 To finalrow
    If Cells(i, j).Value = "0" Then
        For j = 1 To finalcol
            Next j
    Else
        For j = 1 To finalcol
            Next j
            Cells(i, j).Value = "1"
    End If
Next i

运行时我不断收到错误消息。

我的数据结构如下：

0   0   1   0   0   0   1   0   0   0
1   0   0   1   0   0   0   0   0   0
0   0   0   1   0   0   1   0   0   0
0   0   0   1   1   0   0   0   0   0

非常感谢任何帮助或建议。

谢谢。

【问题讨论】：

标签： vba

【解决方案1】：

您的代码存在一些问题（特别是 FOR LOOP 没有多大意义）。

我拿走了你所拥有的，制作了 cmets，然后改成准适合你的要求。

吸收：

Option Explicit 'USE THIS!!!

Sub Test()

    'Dim i, j As Integer NO! "i" is Varaint and you want integer
    Dim i As Integer, j As Integer 'Use this syntax for single line declaration 
    'Adding "Option Explicit" makes you declare these two variables
    Dim finalRow As Integer
    Dim finalCol As Integer

    Dim oneFound As Boolean 'This will be used on the for loop


    finalRow = Range("A65536").End(xlUp).Row 'Do this.  I'm not sure your code works:  Cells(665, 1).End(xlUp).Row 'you had x1, not "XL" (typo)
    finalCol = Range("IV1").End(xlToLeft).Column ''Do this.  I'm not sure your code works:  Cells(1, 10).End(xlToLeft).Column 'had x1, not "XL" (typo)

    oneFound = False
    For i = 1 To finalRow 'You're looping through rows here, now you need to loop through columns

        'REASON FOR YOUR ERROR:  Variable j below is zero at this point and there is no cell (1,0).
        'If Cells(i, j).Value = "0" Then
        For j = 1 To finalCol
            If Cells(i, j).Value = 1 And Not oneFound Then 'We found a one in a cell and we haven't started in filling ones yet
                oneFound = True
            ElseIf Cells(i, j).Value <> 1 And oneFound Then 'You found a one previously in the row and you want to start filling in data
                Cells(i, j).Value = 1
            ElseIf Cells(i, j).Value = 1 And oneFound Then 'You found a one previously in the row and you just found your next one
                'Don't know what you want to do here
                'Setting oneFound to false in case you want to stop filling in data
                oneFound = False
            Else
              'All scenarioes should be covered for what you asking above.
              'You could do something else here should you find the need
            End If
        Next j

        oneFound = False 'Reinitialize for next row
    Next i


End Sub

【讨论】：

完美运行！非常感谢！
+1 以获得有用的解释！
@ray023，我建议你使用Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row 来获取最后一行，因为在 Excel 2007 之后可能有超过 65536 行

【解决方案2】：

如果您只想用 1 替换 0，而不是循环遍历数据，您可以使用搜索和替换功能。

Cells.Select
Selection.Replace What:="0", Replacement:="1"

【讨论】：

这基本上是我需要的，但它是有条件的。我需要替换这些零之间的零，而不是所有零。所以第一行最终看起来像： 0 0 1 1 1 1 1 0 0 0

【解决方案3】：

Sub abc()

j = 2
ActiveSheet.Range("a1").Select
ActiveSheet.Range("a65536").Select
lastrow = Selection.End(xlUp).Row

'/// column a
ActiveSheet.Range("a3:a" & lastrow).Select

    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$A$" & lastrow).AutoFilter Field:=1, Criteria1:="="

    Application.CutCopyMode = False

    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Sheet2").Select
    lrow = ActiveSheet.Range("A65536").End(xlUp).Row
    ActiveSheet.Range("a" & lrow).Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Application.CutCopyMode = False
    Selection.EntireRow.Delete
 Selection.AutoFilter

'column b///////////
ActiveSheet.Range("b3:b" & lastrow).Select

    Selection.AutoFilter
    ActiveSheet.Range("$b$1:$b$" & lastrow).AutoFilter Field:=1, Criteria1:="="

    Application.CutCopyMode = False
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Sheet2").Select
    lrow = activehseet.Range("A65536").End(xlUp).Row
    ActiveSheet.Range("a" & lrow).Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Application.CutCopyMode = False
    Selection.EntireRow.Delete
     Selection.AutoFilter

    'column c////////////

 ActiveSheet.Range("c3:c" & lastrow).Select

    Selection.AutoFilter
    ActiveSheet.Range("$c$1:$c$" & lastrow).AutoFilter Field:=1, Criteria1:="SG Plus", _
    Operator:=xlOr, Criteria2:="=Select"
    Application.CutCopyMode = False
    Range(Selection, Selection.End(xlToRight)).Select
'    Selection.Copy
'    Sheets("Sheet2").Select
'    lrow = activehseet.Range("A65536").End(xlUp).Row
'    ActiveSheet.Range("a" & lrow).Select
'    ActiveSheet.Paste
'    Sheets("Sheet1").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Application.CutCopyMode = False
    Selection.EntireRow.Delete
    Selection.AutoFilter


'column c again/////////////
ActiveSheet.Range("c3:c" & lastrow).Select

    Selection.AutoFilter
    ActiveSheet.Range("$c$1:$c$" & lastrow).AutoFilter Field:=1, Criteria1:="="

    Application.CutCopyMode = False
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Sheet2").Select
    lrow = activehseet.Range("A65536").End(xlUp).Row
    ActiveSheet.Range("a" & lrow).Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Application.CutCopyMode = False
    Selection.EntireRow.Delete
     Selection.AutoFilter

'//////////////////////////// changes oct 21 end


ActiveSheet.Range("a1").Select
For i = 3 To lastrow
Range("a" & i).Select
If Range("a" & i).Value = "MidAmerica" Or Range("a" & i).Value = "Northeast" Or Range("a" & i).Value = "Southeast" Or _
Range("a" & i).Value = "West" Then
GoTo cont
Else

Rows(i).Select
Application.CutCopyMode = False
Selection.Cut
    Sheets("Sheet2").Select
    Range("a" & j).Select
    ActiveSheet.Paste
    j = j + 1
    Sheets("sheet1").Select
       Selection.Delete Shift:=xlUp
   End If
cont:
Next i


'/////// column b ///////////

ActiveSheet.Range("a1").Select
For i = 3 To lastrow
Range("b" & i).Select
If Range("b" & i).Value = "CA" Or Range("b" & i).Value = "AZ" Then
GoTo cont2
Else

Rows(i).Select
Application.CutCopyMode = False
Selection.Cut
    Sheets("Sheet2").Select
    Range("a" & j).Select
    ActiveSheet.Paste
    j = j + 1
    Sheets("sheet1").Select
    Selection.Delete Shift:=xlUp
   End If
cont2:
Next i

'///////////column c //////////

ActiveSheet.Range("a1").Select
For i = 3 To lastrow
Range("c" & i).Select
If Range("c" & i).Value = "SG" Then
GoTo cont3
Else

Rows(i).Select
Application.CutCopyMode = False
Selection.Cut
    Sheets("Sheet2").Select
    Range("a" & j).Select
    ActiveSheet.Paste
    j = j + 1
    Sheets("sheet1").Select
    Selection.Delete Shift:=xlUp
   End If
cont3:
Next i

'//////////column l/////////////
ActiveSheet.Range("a1").Select
For i = 3 To lastrow
Range("l" & i).Select
If Range("l" & i).Value >= "01/01/2014" And Range("l" & i).Value <= "30/06/2014" Then
GoTo cont4
Else

Rows(i).Select
Application.CutCopyMode = False
Selection.Cut
    Sheets("Sheet2").Select
    Range("a" & j).Select
    ActiveSheet.Paste
    j = j + 1
    Sheets("sheet1").Select
    Selection.Delete Shift:=xlUp
   End If
cont4:
Next i

'//////////column m/////////////
ActiveSheet.Range("a1").Select
For i = 3 To lastrow
Range("m" & i).Select
If Range("m" & i).Value >= "12/01" Or Range("m" & i).Value <= "12/05" Then
GoTo cont5
Else

Rows(i).Select
Application.CutCopyMode = False
Selection.Cut
    Sheets("Sheet2").Select
    Range("a" & j).Select
    ActiveSheet.Paste
    j = j + 1
    Sheets("sheet1").Select
    Selection.Delete Shift:=xlUp
   End If
cont5:
Next i

'//////////column q and r/////////////
ActiveSheet.Range("a1").Select
For i = 3 To lastrow
Range("q" & i).Select
If Range("q" & i).Value <> " " And Range("r" & i).Value <> " " And Range("u" & i).Value <> " " _
And Range("z" & i).Value <> " " And Range("aa" & i).Value <> " " And Range("ab" & i).Value <> " " _
And Range("b" & i).Value <> " " And Range("j" & i).Value <> " " Then
GoTo cont6
Else

Rows(i).Select
Application.CutCopyMode = False
Selection.Cut
    Sheets("Sheet2").Select
    Range("a" & j).Select
    ActiveSheet.Paste
    j = j + 1
    Sheets("sheet1").Select
    Selection.Delete Shift:=xlUp
   End If
cont6:
Next i


End Sub

【讨论】：

【解决方案4】：

您可以使用公式来做到这一点，并像这样替换现有值：

Sub Test2()

Dim iRow As Integer
Dim iDx As Integer
Dim iLastRow As Integer
Dim sConcatValues As String
Dim sFormula As String

    sConcatValues = "A:A&B:B&C:C&D:D&E:E&F:F&G:G&H:H&I:I&J:J"

    sFormula = "=LEFT(" & sConcatValues & ",FIND(""1""," _
                        & sConcatValues & ")) & REPT(""1"",FIND(""1""," _
                        & sConcatValues & ",FIND(""1""," _
                        & sConcatValues & ")+1)-1-FIND(""1""," _
                        & sConcatValues & ")) & MID(" _
                        & sConcatValues & ",FIND(""1""," _
                        & sConcatValues & ",FIND(""1""," _
                        & sConcatValues & ")+1),LEN(" _
                        & sConcatValues & "))"

    iLastRow = Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row

    iRow = 1

    ' put in the formula to fix the values
    Range("L1:L" & iLastRow).Formula = sFormula
    Range("L1:L" & iLastRow).Copy
    Range("L1:L" & iLastRow).PasteSpecial xlPasteValues

    ' now copy over the new values, and clean up!
    For iRow = 1 To iLastRow
        For iDx = 1 To Len(Range("L" & iRow).Text)
            Cells(iRow, iDx) = Mid(Range("L" & iRow).Text, iDx, 1)
        Next
    Next

    Range("L1:L" & iLastRow).Clear
    'Range("A1").Activate

End Sub

这是使用的公式：

=LEFT(A:A&B:B&C:C&D:D&E:E&F:F&G:G&H:H&I:I&J:J,FIND("1",A:A&B:B&C:C&D:D&E:E&F:F&G:G&H:H&I:I&J:J)) & REPT("1",FIND("1",A:A&B:B&C:C&D:D&E:E&F:F&G:G&H:H&I:I&J:J,FIND("1",A:A&B:B&C:C&D:D&E:E&F:F&G:G&H:H&I:I&J:J)+1)-1-FIND("1",A:A&B:B&C:C&D:D&E:E&F:F&G:G&H:H&I:I&J:J)) & MID(A:A&B:B&C:C&D:D&E:E&F:F&G:G&H:H&I:I&J:J,FIND("1",A:A&B:B&C:C&D:D&E:E&F:F&G:G&H:H&I:I&J:J,FIND("1",A:A&B:B&C:C&D:D&E:E&F:F&G:G&H:H&I:I&J:J)+1),LEN(A:A&B:B&C:C&D:D&E:E&F:F&G:G&H:H&I:I&J:J))

基本上你连接单元格，然后查找第一个1，然后是下一个1，并使用REPT 函数在两者之间填写

菲利普

【讨论】：

【解决方案5】：

包含这也可能会有所帮助。

http://msdn.microsoft.com/en-us/library/office/aa213567%28v=office.11%29.aspx

Cells.SpecialCells(xlCellTypeLastCell)

而不是使用

finalRow = Range("A65536")...
finalCol = Range("IV1").End(xlToLeft).Column

【讨论】：