簡體   English   中英

根據不起作用的單元格條件將行移動到另一個工作表

[英]Move rows to another sheet based on a cell criteria not working

我正在嘗試編寫一個 vba 代碼以將整行移動到下一個可用工作表中的另一個現有工作表,以獲取一個和多個條件。 我正在處理的文件是從應用程序中導出的,因此具有不可打印的數據。 我首先修剪和清理范圍,然后運行代碼。 我現在有3個問題:

  1. 下面的代碼我用來根據 BY 列中的值將整個移動到另一個工作表應該為空白,然后所有 AG 為空白的行都從 ACCF 主工作表移動到 Accounts Missing Info 工作表。 我在同一個工作簿中有很多前后動作宏。 我不得不更改以下代碼停止工作的宏和 pos 的順序。 我嘗試調試,也沒有錯誤。 2.我還有另一個代碼將整行從 ACCF 主表移動到具有 2 個條件的 Accounts Missing Info 表中的下一個可用列行。 F欄為“JNTN”,M欄為空白。 在我重新排序宏之前,這也可以正常工作。 我嘗試了許多其他代碼,但沒有任何效果。

  2. 第三個問題是,我使用第 2 點中使用的相同代碼來包含日期。 我希望條件 1 = col F 的所有行都為“TRST”,條件 2 為 col Z(這是一個日期)在 2012 年 1 月 5 日之前打開。我不知道如何合並日期。

我知道最好使用的方法是 Autofilter 方法來過濾數據並移動到下一個可用列中的另一張表。 我用谷歌搜索並檢查了視頻,但它們都不起作用。

請幫我。 用於上述所有內容的代碼會很好。 我可以根據要求更改一到兩個標准。

代碼 1

Sub missingphone()

a = worksheets(“ACCF Main”).cells(rows.count,1).End(xlup).row
For i = 2 to a
    If worksheets(“ACCF Main”).cells(i,77).Value= “” then

        Worksheets(“ACCF Main”).rows.copy
        Worksheets(“Accounts missing info”).Activate
        b = worksheets(“Accounts missing info”).cells(rows.count,1).end(xlup).row
        Worksheets(“accounts missing info”).cells(b+1,1).select
        ActiveSheet.paste
        Worksheets(“accf main”).Activate

   End if

Next

Thisworkbook.worksheets(“accf main”).cells(1,1).select

End sub

代碼 2

Sub marriedjoint()

a = worksheets(“ACCF Main”).cells(rows.count,1).end(xlup).row
For i=2 to a
    If worksheets(“ACCF Main”).cells(i,5).Value= “JNTN” And cells(i,13).value=“” then

    Worksheets(“ACCF Main”).rows.copy
    Worksheets(“Accounts missing info”).Activate
    b = worksheets(“Accounts missing info”).cells(rows.count,1).end(xlup).row
    Worksheets(“accounts missing info”).cells(b+1,1).select
   Activesheet.paste
   Worksheets(“accf main”).Activate

   End if

    Next

    Thisworkbook.worksheets(“accf main”).cells(1,1).select

    End sub

如果我對您的代碼 1 和代碼 2 的理解正確:

Sub test()
Dim sh1 As Worksheet: Dim sh2 As Worksheet
Dim rg As Range: Dim cell As Range: Dim rgJNTN As Range

'set the needed sheet as variable sh1 and sh2
Set sh1 = Sheets("ACCF Main")
Set sh2 = Sheets("Accounts missing info")

'set the range of data in column A of sh1
Set rg = sh1.Range("A2", sh1.Range("A" & Rows.Count).End(xlUp))

    'looped to each blank cell in column BY (column 77)
    For Each cell In rg.Offset(0, 76).SpecialCells(xlCellTypeBlanks)
        'copy the entire row of the looped cell into sh2 blank row
        cell.EntireRow.Copy Destination:=sh2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    Next

    'get the range cells which value is "JNTN" in column E sh1 as rgJNTN variable
    With rg.Offset(0, 4)
        .Replace "JNTN", True, xlWhole, , False, , False, False
        Set rgJNTN = .SpecialCells(xlConstants, xlLogical) 
        .Replace True, "JNTN", xlWhole, , False, , False, False
    End With
    
    'loop to each cell (which value is "JNTN") in rgJNTN
    For Each cell In rgJNTN
        'if the looped cell.Offset(0,8) value = "" (column M or column 13, looped cell row)
        'and if the looped cell.offset(0,72) value <> "" (column BY or column 77, looped cell row)
        'then copy the entire row of the looped cell to sh2 blank row
        If cell.Offset(0, 8) = "" And cell.Offset(0, 72).Value <> "" Then cell.EntireRow.Copy Destination:=sh2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    Next

End Sub

沒有在我這邊測試。

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM