# VBA考古 ## 重新排列 ```vba #第一題 Sub rearrange() Application.ScreenUpdating = False Dim RowUsed As Long RowUsed = sheet1.Application.WorksheetFunction.CountA(Range("C:C")) For i = 1 To RowUsed+1 If Range("C" & i).Value <> "" Then GoTo line1 If Range("B" & i).Value <> "" Then 'select two cell Range("A" & i & ":B" & i).Copy Destination:=Range("I" & i - 1) Rows(i).EntireRow.Delete i = i - 1 ElseIf Range("A" & i).Value <> "" Then Range("A" & i).Copy Destination:=Range("J" & i - 1) Rows(i).EntireRow.Delete i = i - 1 Else: Rows(i).EntireRow.Delete i = i - 1 End If line1: Next Application.ScreenUpdating = True End Sub ``` ## 計算書籍金額 ```vba #第二題 Sub BookAmount() Application.ScreenUpdating = False Dim RowUsed As String: RowUsed = Application.WorksheetFunction.CountA(Range("A:A")) 工作表1.Activate Application.CutCopyMode = False Range("A1:A" & RowUsed).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("G1"), Unique:=True For i = 2 To RowUsed Range("D" & i) = Application.WorksheetFunction.Index(工作表2.Range("F:F"), Application.WorksheetFunction.Match(Range("B" & i), 工作表2.Range("D:D"), 0)) * Range("C" & i) Next RowUsed = Application.WorksheetFunction.CountA(Range("G:G")) For i = 2 To RowUsed a = Application.WorksheetFunction.SumIf(Range("A:A"), Range("G" & i), Range("D:D")) Range("H" & i) = a If a > 100000 Then a = a * 0.85 ElseIf a > 50000 Then a = a * 0.9 ElseIf a > 10000 Then a = a * 0.95 End If Range("I" & i) = a Next Application.ScreenUpdating = True End Sub ```