[發問] 求解vba程式

peter631114

hi 版主
有個問題想問vba程式要如何撰寫?詳細資料請參考附件

下載 (117.73 KB)
問題解釋

2019-5-18 15:35

Data.rar (22.76 KB)

詳細資料範本
下載次數: 3

2019-5-18 15:39

kim223824

回復 1# peter631114

Sub 更新_20190519()

    ROW1 = Cells(Rows.Count, "C").End(3).Row
     
    Range("C2").Select
    '排序===============================================================
    ActiveWorkbook.Worksheets("資料").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("資料").Sort.SortFields.Add Key:=Range("C2:C" & ROW1), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("資料").Sort.SortFields.Add Key:=Range("L2:L" & ROW1), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("資料").Sort
        .SetRange Range("A1:M" & ROW1)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Sheets(1).Copy after:=Sheets(Sheets.Count)
    Range("A2:M" & ROW1).ClearContents
    k = ActiveCell.Row
    Sheets(1).Select
    For i = 2 To ROW1
        If Cells(i, "C") = Cells(i + 1, "C") And Cells(i, "L") = Cells(i + 1, "L") Then
            Range(Cells(i, "A"), Cells(i + 1, "M")).Copy Sheets(Sheets.Count).Cells(k, "A")
        k = k + 2
        End If
      Next

End Sub

Data.zip (32.59 KB)

下載次數: 5

2019-5-19 10:01

peter631114

謝謝大大,我試試看,有問題再問大大
真的感恩