---
# System prepended metadata

title: VBA考古

---

# 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

```