Question

我需要编写一个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

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

感谢。

Answer 1

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

我拿走你所拥有的并发表评论，并改为准你想要的东西。

吸收：

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

Answer 2

如果您要做的只是将零替换为1，而不是循环访问数据，您可以使用搜索和替换功能。

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

Answer 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

Answer 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函数之间填写

菲利普

Answer 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

在Excel中使用条件循环遍历列

5 个答案: