excel宏·终极版

Private Sub CommandButton1_Click()'Sheet1=Q20.list;Sheet2=Q20trim.list;Sheet3=源数据表_副本'新建Sheet4=批量合成+删除空行+变成M'最终数据存于Sheet3列PQR'批量合成Dim s As Integers = TextBox1.TextFor i = 1 To s    Sheet4.Cells(i, 1) = Mid(Sheet1.Cells(i, 1), 5, 5)    Sheet4.Cells(i, 4) = Mid(Sheet2.Cells(i, 1), 5, 5)    Sheet4.Cells(i, 2) = Sheet1.Cells(i, 2)    Sheet4.Cells(i, 5) = Sheet2.Cells(i, 2)Next'合并计算For i = 1 To s    For j = 1 To i - 1        If Sheet4.Cells(j, 1) = Sheet4.Cells(i, 1) Then            Sheet4.Cells(i, 2) = Sheet4.Cells(i, 2) + Sheet4.Cells(j, 2)            Sheet4.Cells(j, 1) = ""            Sheet4.Cells(j, 2) = ""        End If    Next    For j = i + 1 To s        If Sheet4.Cells(j, 1) = Sheet4.Cells(i, 1) Then            Sheet4.Cells(i, 2) = Sheet4.Cells(i, 2) + Sheet4.Cells(j, 2)            Sheet4.Cells(j, 1) = ""            Sheet4.Cells(j, 2) = ""        End If    NextNextFor i = 1 To s   For j = 1 To i - 1        If Sheet4.Cells(j, 4) = Sheet4.Cells(i, 4) Then            Sheet4.Cells(i, 5) = Sheet4.Cells(i, 5) + Sheet4.Cells(j, 5)            Sheet4.Cells(j, 4) = ""            Sheet4.Cells(j, 5) = ""        End If    Next    For j = i + 1 To s        If Sheet4.Cells(j, 4) = Sheet4.Cells(i, 4) Then            Sheet4.Cells(i, 5) = Sheet4.Cells(i, 5) + Sheet4.Cells(j, 5)            Sheet4.Cells(j, 4) = ""            Sheet4.Cells(j, 5) = ""        End If    NextNext'数据合并For i = 1 To s    For j = 1 To s        If Sheet4.Cells(j, 4) = Sheet4.Cells(i, 1) Then            Sheet4.Cells(i, 3) = Sheet4.Cells(j, 5)            Sheet4.Cells(j, 4) = ""            Sheet4.Cells(j, 5) = ""        End If    NextNext'删除空行For i = 1 To s    If Sheet4.Cells(i, 1) = "" Then        Sheet4.Rows(i).Delete    End IfNextFor i = 1 To s    If Sheet4.Cells(i, 1) = "" Then        Sheet4.Rows(i).Delete    End IfNextFor i = 1 To s    If Sheet4.Cells(i, 1) = "" Then        Sheet4.Rows(i).Delete    End IfNextFor i = 1 To s    If Sheet4.Cells(i, 1) = "" Then        Sheet4.Rows(i).Delete    End IfNext'变成MFor i = 1 To s / 2    Sheet4.Cells(i, 2) = Sheet4.Cells(i, 2) / 1000000    Sheet4.Cells(i, 3) = Sheet4.Cells(i, 3) / 1000000Next'转移到Sheet3For i = 1 To s / 2    For j = 3 To (s / 2 + 3)        If Mid(Sheet3.Cells(j, 2), 5, 5) = Sheet4.Cells(i, 1) Then            Sheet3.Cells(j, 16) = Sheet4.Cells(i, 2)            Sheet3.Cells(j, 16).NumberFormatLocal = "0.0_ "            Sheet3.Cells(j, 17) = Sheet4.Cells(i, 3)            Sheet3.Cells(j, 17).NumberFormatLocal = "0.0_ "        End If    NextNext'求百分比Sheet3.Columns("R:R").NumberFormatLocal = "0.0%"For i = 3 To (s / 2 + 3)    If Sheet3.Cells(i, 1) <> "" Then        Sheet3.Cells(i, 18) = Sheet3.Cells(i, 17) / Sheet3.Cells(i, 16)    End IfNextEnd Sub