cclo0728

回復 20# kim223824
感謝KIM,我這邊已經完成了
但就卡在公司的EXCEL是大陸的WPS,無法執行自動列印功能(在網路上案例中)
感謝你跟准大的技術指導,謝謝

cclo0728

回復 20# kim223824

請教KIM大
我在VBA那邊想改成收尋"土"這個字,但是跑出來不是空白,就是只有日期
是那邊沒有改好,麻煩指點一下,謝謝

kim223824

回復 22# cclo0728


    公式1.zip (27.64 KB)

下載次數: 8

2019-10-9 16:03

cclo0728

回復 23# kim223824
感謝,我忘記廠商名稱要符合第一頁比對的要點了:(
另外想請教一個問題,有辦法依廠商顯示出較多時,自動移置新增分頁嗎?
如土在第一頁有3個出現,花可能出現2個,其他可能只出現1次,抓取較多數或前幾名直接分頁新工作表

kim223824

回復 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)

下載次數: 8

2019-10-10 11:42

cclo0728

回復 25# kim223824
感謝KIM,想再請教
1.公司的客戶別很多,如何排定前幾大筆數較多的自動分頁出來(例如我只要前三名,後面的不用自動分頁)
2.在欠料表中,分頁出來後能夠將原本欠料表刪除嗎?
3.假如我用樞紐跑一開始的欠料,有辦法跟第一個問題一樣,用樞紐抓總筆數?(在更新2頁是不是可以不用COUNTIF?
4.欄位中有一個叫預計開工,因公司同仁都會排序日期小到大,假設以今天日期+1的話,也就是20191015之後的後面資料能夠自動刪除嗎
抱歉問題有點多,但想很久查GOOGLE也查不太到,再麻煩指點