返回列表 上一主題 發帖

如何讓料號能夠自動判定並複製去指定的工作表

回復 1# cclo0728

Sub test_20190702()
    Sheets("Sheet1(自動增加並放置AC及EC料").Select
    ROW1 = Cells(Rows.Count, "C").End(3).Row
    If ROW1 > 2 Then
        Range(Cells(1, "C"), Cells(ROW1, "E")).Clear
    End If
   
    ROW1 = Cells(Rows.Count, "A").End(3).Row
   
    arr = Range("A2:A" & ROW1)
   
    ROW2 = Sheets(1).Cells(Rows.Count, "A").End(3).Row
   
    Sheets(1).Range("A1:C" & ROW2).AdvancedFilter _
        Action:=xlFilterCopy, CriteriaRange:=Range("A1:A" & ROW1), CopyToRange:=Range( _
        "C1"), Unique:=False
   
    Columns("C:C").ColumnWidth = 14
    Columns("D:D").ColumnWidth = 16
    Columns("E:E").ColumnWidth = 8
   
    '==============================================================
    Sheets("Sheet2(自動增加並放置EA及EB料號").Select
   
    ROW1 = Cells(Rows.Count, "C").End(3).Row
    If ROW1 > 2 Then
        Range(Cells(1, "C"), Cells(ROW1, "E")).Clear
    End If

    Range("A1").Select
   
    ROW1 = Cells(Rows.Count, "A").End(3).Row
   
    brr = Range("A2:A" & ROW1)
   
    Sheets(1).Range("A1:C" & ROW2).AdvancedFilter _
        Action:=xlFilterCopy, CriteriaRange:=Range("A1:A" & ROW1), CopyToRange:=Range( _
        "C1"), Unique:=False
    Columns("C:C").ColumnWidth = 14
    Columns("D:D").ColumnWidth = 16
    Columns("E:E").ColumnWidth = 8

    Sheets.Add After:=Sheets(Sheets.Count)
    Columns("A:A").ColumnWidth = 14
    Columns("B:B").ColumnWidth = 16
    Columns("C:C").ColumnWidth = 8
   
    Sheets(1).Range("A1:C" & ROW2).Copy Range("A1")
   
    For i = ROW2 To 2 Step -1
        
        For j = 1 To UBound(arr)
            If Cells(i, "A") Like arr(j, 1) Then
                Rows(i).Delete
                GoTo 1100
            End If
        Next
        For j = 1 To UBound(brr)
            If Cells(i, "A") Like brr(j, 1) Then
                Rows(i).Delete
                GoTo 1100
            End If
        Next
1100:
   
    Next

End Sub
測試.zip (20.84 KB)

TOP

回復 3# cclo0728

目前幫你考慮的內容如下:
1. 作業方式是用 EXCEL中的  "進階篩選",將你要的料號抬頭 選出。
2. 指定料號的頁數只有固定兩頁(頁面名稱不可更改)。
3. 但是指定料號的內容可能會變 (EA ==> EZ),所以只要在A欄 KEYIN你要的料號抬頭就可以有新的料號 ex:  EZ*

TOP

回復 5# 准提部林


    感謝,讓我又提升了。

TOP

回復 9# cclo0728

   
     ROW1 = Cells(Rows.Count, "C").End(3).Row           '知道C欄最後一個有資料的位置
     If ROW1 > 2 Then                                                            '如果ROW1 >2 表示 你的C欄有資料
          Range(Cells(1, "C"), Cells(ROW1, "E")).Clear                '將C欄~E欄都清除
     End If
     '==============================
     
     ROW1 = Cells(Rows.Count, "A").End(3).Row          '知道A欄最後一個有資料的位置
     arr = Range("A2:A" & ROW1)      '將A欄的資料放進arr的陣列變數裡面

TOP

回復 19# cclo0728

你在把你的需求寫清楚一點,目前SHEET3已經可以刪除sheet1/sheet2的品號。
預計出貨.zip (56.51 KB)

TOP

回復 22# cclo0728


    公式1.zip (27.64 KB)

TOP

回復 24# cclo0728

Sub 各別將廠商分頁()
    f1 = Sheets.Count   '判斷現在有幾頁
    ROW1 = Cells(Rows.Count, "A").End(3).Row
   
    If ROW1 > 2 Then
        Range(Cells(1, "A"), Cells(ROW1, "B")).Clear
    End If

    If f1 > 3 Then  '判斷頁面大於3頁 表示有原來的資料 刪除
        For i = f1 To 4 Step -1         '從最後一頁往前 刪除
            Application.DisplayAlerts = False '關閉提醒
            Sheets(i).Delete
            Application.DisplayAlerts = True   '開啟提醒
        Next
    End If
   
    ROW1 = Sheets("欠料").Cells(Rows.Count, "C").End(3).Row
    Sheets("欠料").Range("B1:B" & ROW1).Copy Range("A1")
   
    Range("B2:B" & ROW1) = "=COUNTIF(A:A,A2)"
    Range("B2:B" & ROW1).Value = Range("B2:B" & ROW1).Value
   
    '排序 大到小============
    ActiveWorkbook.Worksheets("更新2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("更新2").Sort.SortFields.Add Key:=Range("B2:B" & ROW1), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("更新2").Sort
        .SetRange Range("A1:B" & ROW1)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    '移除重複========================
    ActiveSheet.Range("$A$1:$B$" & ROW1).RemoveDuplicates Columns:=Array(1, 2), Header _
        :=xlYes
   
    ROW1 = Cells(Rows.Count, "A").End(3).Row
   
    arr = Range("A2:B" & ROW1)
   
    ROW2 = Sheets(1).Cells(Rows.Count, "A").End(3).Row
   
    '新增頁面==============================
    For i = 1 To UBound(arr)
        Sheets.Add after:=Sheets(Sheets.Count)
        Sheets(i + 3).Name = arr(i, 1)
        Range("A1").Value = "客戶簡稱"
        Range("A2").Value = arr(i, 1)
        
        ROW3 = Cells(Rows.Count, "A").End(3).Row
        '進階篩選===============================
        Sheets(1).Range("A1:AA" & ROW2).AdvancedFilter _
        Action:=xlFilterCopy, CriteriaRange:=Range("A1:A" & ROW3), CopyToRange:=Range( _
        "C1"), Unique:=False
        Range("A:B").Delete
    Next

    Sheets("更新2").Select

    ROW3 = Cells(Rows.Count, "A").End(3).Row
   
    Range(Cells(1, "A"), Cells(ROW3, "B")).Clear
   
End Sub


    公式1.zip (51.32 KB)

TOP

        靜思自在 : 難行能行,難捨能捨,難為能為,才能昇華自我的人格。
返回列表 上一主題