excel 值为负值时粘贴循环

1zmg4dgp  于 2022-12-19  发布在  其他
关注(0)|答案(2)|浏览(137)

我正在尝试创建一个粘贴循环,并希望只要列中的值为负值,循环就会继续,并将其粘贴到用户将选择的另一个工作簿中。此外,我需要先粘贴一个区域,然后再粘贴另一个区域。在新工作簿中,我需要在完成4盎司循环后开始向下粘贴一个单元格,以便开始8盎司循环。

Sub Absolute_Value()

' Absolute_Value Macro
' Defining Terms

Dim sht As Worksheet
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim sht3 As Worksheet
Dim nwbsht1 As Worksheet
Dim nwbsht2 As Worksheet
Dim nwbsht3 As Worksheet
Dim nwbsht4 As Worksheet
Dim nwbsht5 As Worksheet
Dim nwbsht6 As Worksheet
Dim nwbsht7 As Worksheet
Dim nwbsht8 As Worksheet
Dim rngToAbs As Range
Dim LastRow As Long
Dim LastRW As Long
Dim LastRW1 As Long
Dim LastRW2 As Long
Dim LastRW3 As Long
Dim LastRW4 As Long
Dim LastRW5 As Long
Dim LastRW6 As Long
Dim LastRW7 As Long
Dim LastRW8 As Long
Dim LastRW9 As Long
Dim LastRW10 As Long
Dim c As Range
Dim wb As Workbook
Dim nwb As Workbook
Dim i As Range
Dim OnHand As Range
Dim OnHand2 As Range
Dim OnHand1 As Range
Dim Pallet As Range
Dim PalletType As Range
Dim Item As Range
Dim Item2 As Range
Dim UnitQty As Range

'Setting ranges for PackPlan workbook
Set wb = Application.ActiveWorkbook
Set sht = wb.Sheets("Arils Pack Plan ")
    LastRow = sht.Cells(sht.Rows.Count, "F").End(xlUp).Row
    Set rngToAbs = sht.Range("F7:F" & LastRow)

Set wb = Application.ActiveWorkbook
Set sht1 = wb.Sheets("Arils Pack Plan ")
    LastRW5 = sht1.Cells(sht1.Rows.Count, "B").End(xlUp).Row
    Set Item = sht1.Range("B7:B" & LastRW5)

Set wb = Application.ActiveWorkbook
Set sht2 = wb.Sheets("Arils Pack Plan ")
    LastRW4 = sht2.Cells(sht2.Rows.Count, "E").End(xlUp).Row
    Set PalletType = sht2.Range("E7:E" & LastRW4)

'Opening Recent ATS report

With Application.FileDialog(msoFileDialogOpen)
    .Filters.Clear
    .Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
    .AllowMultiSelect = False
    .Show
Application.Workbooks.Open .SelectedItems(1)
Set nwb = Application.ActiveWorkbook

End With

'Setting Ranges for Daily Need Worksheet

'4oz Range Setting

Set nwb = Application.ActiveWorkbook
Set nwbsht1 = nwb.Sheets("DAILY NEED (DR)")
    LastRW = nwbsht1.Cells(nwbsht1.Rows.Count, "Q").End(xlUp).Row
    Set OnHand = nwbsht1.Range("Q5:Q14" & LastRW)

Set nwb = Application.ActiveWorkbook
Set nwbsht2 = nwb.Sheets("DAILY NEED (DR)")
    LastRW6 = nwbsht2.Cells(nwbsht2.Rows.Count, "E").End(xlUp).Row
    Set Pallet = nwbsht2.Range("E5:E14" & LastRW6)

Set nwb = Application.ActiveWorkbook
Set nwbsht3 = nwb.Sheets("DAILY NEED (DR)")
    LastRW1 = nwbsht3.Cells(nwbsht3.Rows.Count, "T").End(xlUp).Row
    Set OnHand1 = nwbsht3.Range("T5:T14" & LastRW1)

Set nwb = Application.ActiveWorkbook
Set nwbsht4 = nwb.Sheets("DAILY NEED (DR)")
    LastRW2 = nwbsht4.Cells(nwbsht4.Rows.Count, "Y").End(xlUp).Row
    Set OnHand2 = nwbsht4.Range("Y5:Y14" & LastRW2)

'8oz Range Setting
Set nwb = Application.ActiveWorkbook
Set nwbsht5 = nwb.Sheets("DAILY NEED (DR)")
    LastRW7 = nwbsht5.Cells(nwbsht5.Rows.Count, "Q").End(xlUp).Row
    Set OnHand = nwbsht5.Range("Q15:Q25" & LastRW7)

Set nwb = Application.ActiveWorkbook
Set nwbsht6 = nwb.Sheets("DAILY NEED (DR)")
    LastRW8 = nwbsht6.Cells(nwbsht6.Rows.Count, "E").End(xlUp).Row
    Set Pallet = nwbsht6.Range("E15:E25" & LastRW8)

Set nwb = Application.ActiveWorkbook
Set nwbsht7 = nwb.Sheets("DAILY NEED (DR)")
    LastRW9 = nwbsht7.Cells(nwbsht7.Rows.Count, "T").End(xlUp).Row
    Set OnHand1 = nwbsht7.Range("T15:T25" & LastRW9)

Set nwb = Application.ActiveWorkbook
Set nwbsht8 = nwb.Sheets("DAILY NEED (DR)")
    LastRW10 = nwbsht8.Cells(nwbsht8.Rows.Count, "Y").End(xlUp).Row
    Set OnHand2 = nwbsht8.Range("Y15:Y25" & LastRW10)

'Copy and Paste Loop
nwb.Activate

Do While i < OnHand
For i = 1 to
If OnHand.Value < 0 Then
    nwb.Activate
    OnHand.Select
    wb.Activate
    Selection.Copy
    rngToAbs.PasteSpecial Paste:=xlPasteValues
End If
Next i

' Absolute_Value Macro
For Each c In rngToAbs
    c.Value = Abs(c.Value)
    If rngToAbs.Cells(c, 1).Value <> "" Then Exit For
Next c
End Sub
k97glaaz

k97glaaz1#

作为对我关于为同一对象设置多个变量的评论的澄清...
而不是这个:

'Setting ranges for PackPlan workbook
   Set wb = Application.ActiveWorkbook
    Set sht = wb.Sheets("Arils Pack Plan ")
        LastRow = sht.Cells(sht.Rows.Count, "F").End(xlUp).Row
        Set rngToAbs = sht.Range("F7:F" & LastRow)
    
    Set wb = Application.ActiveWorkbook
    Set sht1 = wb.Sheets("Arils Pack Plan ")
        LastRW5 = sht1.Cells(sht1.Rows.Count, "B").End(xlUp).Row
        Set Item = sht1.Range("B7:B" & LastRW5)
    
    Set wb = Application.ActiveWorkbook
    Set sht2 = wb.Sheets("Arils Pack Plan ")
        LastRW4 = sht2.Cells(sht2.Rows.Count, "E").End(xlUp).Row
        Set PalletType = sht2.Range("E7:E" & LastRW4)

你可以这样做:

With ActiveWorkbook.Worksheets("Arils Pack Plan ")
        Set rngToAbs = .Range("F7:F" & .Cells(.Rows.Count, "F").End(xlUp).Row)
        Set Item = .Range("B7:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
        Set PalletType = .Range("E7:E" & .Cells(.Rows.Count, "E").End(xlUp).Row)
    End With

不过,通常情况下,您不希望使用不同的“最后一行”值从同一个表中阅读列--选择一列来查找最后一行,然后将其用于表中的所有列。

beq87vna

beq87vna2#

我想这就是你试图用for循环来完成的事情:

Sub Example()

    Dim CL As Range
    Dim Onhand As Range
    
'   All the rest of your code...

    For Each CL In Onhand.Cells
        If CL.Value < 0 Then
            nwb.Activate
            CL.Select
            wb.Activate
            Selection.Copy
            rngToAbs.PasteSpecial Paste:=xlPasteValues
        End If
    Loop
    
End Sub

相关问题