5.EXCEL中的VBA程式碼

今天有一同學,喊我幫忙處理EXCEL中資料的問題,題目表述太含糊,簡單說,分3步工作:
1)找出SHEET1的"甲列"中相同的行,
2)把相同的行對應的"乙列"中的行求和SUM,
3)找出SHEET2的"丙列"中與"甲列"中相同的行,並把此行對應的"丁列"的值置為SUM.
  個人對EXCEL中的公式與函式不熟悉,又沒有找到合適的人詢問,只好自己在VBA裡寫程式碼.
因太久沒有碰過VB,而且又不知道同學是否會再次喊我做同樣的事情,所以把程式碼貼在這裡,以備後用.

Sub SelectData()

    Dim i As Long, Max As Long, j As Long, Max2 As Long
    Dim count As Long
   
    Dim val As Double

    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim col11 As String, col12 As String, col13 As String, col21 As String, col22 As String
    col11 = "A"             '合併的列
    col12 = "C"             '累加資料列
    col13 = "A"             '與另一個SH2比較的列
   
    col21 = "B"             '與SH1比較的列
    col22 = "C"             '和資料存放的列

    Set sh1 = Sheet2
    Set sh2 = Sheet3  
    
    j = 1
    i = 1
    count = 1
    Max2 = 302
    Max = 252
    val = sh1.Range(col12 & 1).Value
   
    Do

        If sh1.Range(col11 & count).Value = sh1.Range(col11 & (i + 1)).Value Then

            val = val + sh1.Range(col12 & (i + 1)).Value
            i = i + 1

        Else
           
            For j = 1 To Max2
                If sh2.Range(col21 & j).Value = sh1.Range(col13 & (count)).Value Then
                    sh2.Range(col22 & j).Value = val
                    Exit For
                End If
               
            Next       
            
            i = i + 1
            count = i
            val = sh1.Range(col12 & i).Value                  
            
        End If

    Loop While i < Max              

End Sub

 

記:果然同學又有了新的功能,在原先的基礎上修改就比較順利了.

Sub SelectData()

    Dim i As Long, Max As Long, j As Long, Max2 As Long
    Dim count As Long
   
 
    Dim sh1 As Worksheet
    Dim col11 As String, col12 As String, col13 As String, col14 As String
    col11 = "A"             '合併的列
    col12 = "B"             '累加資料列
    col13 = "C"             '與另一個SH2比較的列
    col14 = "D"             '與另一個SH2比較的列
   

    Set sh1 = Sheet1
   
    j = 1
    i = 1
    count = 1
   
   
    Max2 = 10           'C列最大行數+1
    Max = 10            'A列最大行數
   
    Dim flg As Integer
   
    Do

            flg = 0
            For j = 1 To Max
                If sh1.Range(col11 & j).Value = sh1.Range(col13 & (count)).Value Then
                    sh1.Range(col14 & count).Value = sh1.Range(col12 & j).Value
                    flg = 1
                    Exit For
                End If
               
            Next
            If flg = 0 Then
                sh1.Range(col14 & count).Value = 0
            End If
            i = i + 1
            count = i
           
           
    Loop While i < Max2

End Sub