这是在EXCEL中按某一列求同类项合并的程序,当有100多条记录求时,执行起来特别慢,求大虾优化Private Sub CommandButton1_Click()
rangename1 = TextBox1.Text
qq = Val(TextBox2.Text)
startrange1 = qq + 1
endrange1 = Val(TextBox3.Text)
rangename2 = TextBox1.Text
startrange2 = Val(TextBox2.Text)
endrange2 = Val(TextBox3.Text)
For a = startrange2 To endrange2
c$ = a
row2 = Chr(Asc(rangename2) + 1)
row3 = Chr(Asc(rangename2) + 2)
row4 = Chr(Asc(rangename2) + 3)
row5 = Chr(Asc(rangename2) + 4)
row6 = Chr(Asc(rangename2) + 5)
row7 = Chr(Asc(rangename2) + 6)
row8 = Chr(Asc(rangename2) + 7)
aaa:  For d = startrange1 To endrange1
    r$ = d
    range1 = Chr(Asc(rangename1) + 0)
    range2 = Chr(Asc(rangename1) + 1)
    range3 = Chr(Asc(rangename1) + 2)
    range4 = Chr(Asc(rangename1) + 3)
    range5 = Chr(Asc(rangename1) + 4)
    range6 = Chr(Asc(rangename1) + 5)
    range7 = Chr(Asc(rangename1) + 6)
    range8 = Chr(Asc(rangename1) + 7)
    Range(rangename2 + c$).Select
    qs = ActiveCell.Value
    Range(rangename1 + r$).Select
    xh = ActiveCell.Value
   
  If qs = xh Then
    Range(row4 + c$).Select
    sl2 = ActiveCell.Value
    Range(range4 + r$).Select
    sl1 = ActiveCell.Value
    sl = sl1 + sl2
    Range(range2 + r$ + ":" + range8 + r$).Select
    Selection.EntireRow.Delete
    endrange2 = endrange2 - 1
    endrange1 = endrange1 - 1
    Range(row4 + c$).Select
    ActiveCell.FormulaR1C1 = sl
    If startrange1 < endrange1 Then GoTo aaa    Exit For
   End If
  Next d
  startrange1 = startrange1 + 1
 Next a
End Sub

解决方案 »

  1.   

    先把表中的数据读入内存,直接操作内存数据        Dim objDateRange As Range
            Dim objRangeValue As Variant
            With objOpSheet
                Set objDateRange = .Range(.Cells(Target.Row + 2, 2), .Cells(Target.Row + 32, 25))
                objDateRange.ClearContents
                '将要修改的数据区读入内存,要写回去的时候反过来就好了
                objRangeValue = objDateRange.Value
            End With