Question

我正在尝试编写一个循环，测试每个单元格中的数字1，当存在一个时，我想将值存储在相邻单元格中（列A）并将所有这些单元转置到单独的工作表中。

然而，VBA不是我的优点之一，我正在努力让第一部分工作，我的代码：

Sub test_loop()

Dim Needed_range As Long
Needed_range = Cells(Rows.Count, "B").End(xlUp).Row
    For Each cell In Range(Needed_range)
        If cell = 1 Then
           MsgBox "Yes"
           Exit Sub
        End If
    Next cell

End Sub

很抱歉，如果这是非常基本的，我不经常使用VBA，我需要复习才能完成这个项目！

Answer 1

循环列B并返回带行号的是，然后将列B的值保存到列A

Sub test_loop()

Dim i As Long

    For i = 1 To Cells(Rows.Count, "B").End(xlUp).Row

        If Cells(i, "B").Value = 1 Then
            MsgBox "Yes! Appears at row " & i
            Cells(i,"A").Value = Cells(i, "B").Value
        End If

    Next

End Sub

Answer 2

使用For Each循环很好，但是你需要构建一个Range对象来循环遍历。

Option Explicit

Sub test_loop()
    Dim neededRange As Range, cell As Range

    'get the range to loop through
    With ThisWorkbook.Worksheets("Sheet1")
        Set neededRange = Range(.Cells(1, "B"), .Cells(.Rows.Count, "B").End(xlUp))
    End With

    For Each cell In neededRange
        If cell.Value = 1 Then
           cell.Offset(0,-1).Value = cell.Value 'put 1 into column A
           'do something else
        End If
    Next cell
End Sub

尽量不要在变量名中加以强调。下划线在VBA的其他地方具有特定含义
不要忘记声明所有变量 - 我为你宣布cell。如果您在代码顶部添加Option Explicit，则系统会提醒您
而不只是Range("A1")尝试完全限定您的范围。即Workbooks("..").Worksheets("..").Range("A1")。我已在With声明

Answer 3

访问工作表对象（例如Value = ..something）需要花费最长时间来处理代码。

你可以通过使用“助手”范围避免这种情况，在下面的代码中我使用CopyValRng，每次B列中的单元格等于1（cell.Value = 1）时，我都可以m使用Application.Union将左侧（A列）的单元格添加到该范围。

最后，我只是使用CopyValRng.Value = 1一次更改整个范围内的值。

<强> 代码

Option Explicit

Sub test_loop()

Dim Sht As Worksheet
Dim Needed_range As Range, cell As Range, CopyValRng As Range
Dim LastRow As Long

' set the worksheet object, modify "Sheet1" to your sheet's name
Set Sht = ThisWorkbook.Sheets("Sheet1")
With Sht
    ' get last row in column B
    LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row

    ' set the range
    Set Needed_range = .Range("B1:B" & LastRow)

    ' loop through the Range
    For Each cell In Needed_range
        If cell.Value = 1 Then
            If Not CopyValRng Is Nothing Then
                Set CopyValRng = Application.Union(CopyValRng, cell.Offset(0, -1))
            Else
                Set CopyValRng = cell.Offset(0, -1)
            End If
        End If
    Next cell    
End With

' make sure there's at least 1 cell in the range, then put 1's in all the cells in column A at once
If Not CopyValRng Is Nothing Then CopyValRng.Value = 1

End Sub

Answer 4

（requiredRange没有存储范围，只是存储在coolumn B中的最后一个非空行）试试这段代码：

    Sub test_loop()

    lastRow = Cells(Rows.Count, "B").End(xlUp).Row

        For i = 1 To lastRow
            If Cells(i, 2).Value = 1 Then
            Cells(i, 2).Select
               MsgBox "Yes"
               Exit Sub
            End If
        Next i

    End Sub

对于每个和if循环

4 个答案: