基于單元格值的回圈和粘貼

我已經啟動了這段代碼，它在作業表 PCrun 中查找單元格 D2 中的“是”，然后復制 A1:C9 并作為影像粘貼到從單元格 A1 開始的作業表 PCexport。這有效，但我還堅持了幾個步驟。我希望它轉到下一個單元格 A10:C18 范圍，在單元格 D11 中尋找是。這需要繼續，即 D2 - C1:C9 D11 - A10:C28 D20 - A19:C27 等等，每次加 9，如果 D 中有“是”，則進行處理，然后作為圖片粘貼到作業表 PCexport 中的下一個可用單元格。

Sub CopyIf()
Dim LastRow As Long, i As Long, erow As Long
Dim wsStr As String
Dim ws As Worksheet, wsC As Worksheet
Dim wb As Workbook, wbM As Workbook
Dim C As Range
LastRow = Worksheets("PCexport").Range("A" & Rows.Count).End(xlUp).Row


Set wb = ActiveWorkbook
Set wsC = wb.Sheets("PCrun")
erow = wsC.Cells(Rows.Count, 1).End(xlUp).Row

Worksheets("PCrun").Activate
 For i = 1 To LastRow
If wsC.Cells(2, 4).Value = "YES" Then
        erow = erow   9
        wsC.Range(wsC.Cells(1, 1), wsC.Cells(9, 3)).CopyPicture 'avoid select
        Sheets("PCexport").Range("A1").PasteSpecial
    End If
 Next i  End Sub

uj5u.com熱心網友回復：

有些是我想到的。

` 子 CopyIf()

Set Ask = Worksheets("PCrun").Range("$d2")
Set CP = Worksheets("PCrun").Range("a1:c9")
Set Give = Worksheets("PCexport").Range("$a1")
Worksheets("PCrun").Activate

For j = 0 To 135 Step 9
 Set CPvar = CP.Offset(j, 0)
 Set Askvar = Ask.Offset(j, 0)
 Set Givevar = Give.Offset(j, 0)


          If Askvar.Value = "YES" Then
          
        CPvar.CopyPicture
        With Sheets("PCexport").Range("A"  & Rows.Count).End(xlUp).Offset(1).PasteSpecial
        End With
    End If
Next j
End Sub`

uj5u.com熱心網友回復：

嘗試在參考 Sub CopyIf() Dim LastRow As Long, i As Long, erow As Long Dim ws As Worksheet, wsC As Worksheet Dim wb As Workbook Dim C As Range LastRow = Worksheets("PCexport") 中合并您的 for-step .Range("A" & Rows.Count).End(xlUp).Row

Set wb = ActiveWorkbook
Set wsC = wb.Sheets("PCrun")
erow = wsC.Range("A" & Rows.Count).End(xlUp).Row   1

Worksheets("PCrun").Activate
 For i = 0 To LastRow -1 Step 9
If wsC.Cells(2   i, 4).Value = "YES" Then
        wsC.Range(wsC.Cells(1   i, 1), wsC.Cells(9   i, 3)).CopyPicture 'avoid select 'not sure why you're opting for pictures
        Sheets("PCexport").Range("A" & erow).PasteSpecial
erow = erow   9 'you were filling your erow but weren't using it
    End If
 Next i  
End Sub

uj5u.com熱心網友回復：

這似乎可以滿足我的所有需求。

{Sub CopyIf() Dim i As Long, erow As Long Dim wsStr As String Dim ws As Worksheet, wsC As Worksheet Dim wb As Workbook, wbM As Workbook Dim C As Range}

Set Ask = Worksheets("PCrun").Range("$d2")
Set CP = Worksheets("PCrun").Range("a1:c9")
Set Give = Worksheets("PCexport").Range("$a1")
Set Take = Worksheets("PCexport").Range("a1")

Worksheets("PCrun").Activate

For j = 0 To 135 Step 9
 Set CPvar = CP.Offset(j, 0)
 Set Askvar = Ask.Offset(j, 0)
 Set GiVevar = Give.Offset(j, 0)
 Set Takevar = Take.Offset(j, 0)

          If Askvar.Value = "YES" Then
          
        CPvar.CopyPicture
        GiVevar.Offset.PasteSpecial
        Else
        Takevar.Value = 1

        End If
Next j
 Worksheets("PCexport").Activate
 Set Check = Worksheets("PCexport").Range("a1")
 Set Take2 = Worksheets("PCexport").Range("A1:C9")

 For k = 0 To 135 Step 9
 
 Set Checkvar = Check.Offset(k, 0)
 Set Take2var = Take2.Offset(k, 0)

  If Checkvar.Value = "1" Then
  Take2var.Delete
 End If
Next k
  

標籤：循环变量

上一篇：將多個未知數添加到Pyton中的字串

下一篇：在R中執行測驗以檢查每35-37行資料集是否存在所有測驗