使用类模块完美模拟RefEdit控件

彭希仁

由于RefEdit控件本身存在兼容性问题，通过类模块的事件完美模拟它。

窗体UserForm1代码
Public ref1 As New refb
Private Sub TextBox4_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Set ref1.Appb = Application
    Set ref1.Userb = Me
    ref1.s = "TextBox4"
End Sub
Private Sub TextBox5_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   Set ref1.Appb = Application
    Set ref1.Userb = Me
    ref1.s = "TextBox5"
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
   Set ref1.Appb = Nothing
   Set ref1.Userb = Nothing
   ref1.s = ""
End Sub



类模块refb代码
Public WithEvents Appb As Application
Public Userb As UserForm
Public s As String

Private Sub Appb_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If s <> "" Then Userb.Controls(s).Text = "'" & ActiveSheet.Name & "'!" & Selection.Address
End Sub


模块代码
Sub 调用ref()
UserForm1.Show (0)
End Sub

ivccav

占个沙发，回去研究一下。

yf_home

留个记号！

4014437

麻烦版主删掉这个帖子求助跨工作簿求和，每个工作簿的工作表名称相同，汇总到同一个工作簿中进行求和！！！ http://club.excelhome.net/thread-1396017-1-1.html (出处: ExcelHome技术论坛)

kangren6772

版主，很想弄懂您的算法思路，能不能解释一下，多谢！
pengxiren() '彭版数组法组合求和

    Application.ScreenUpdating = False
    aa = Timer
    Dim arr(1 To 11, 1 To 2) As Integer
    Dim a As String
    Dim Z As Integer, arr1
    Dim i As Integer
    Dim c As Long
    Dim sum1 As Long
    Dim sum2 As Long
    Dim x As Long
    Dim y As String
    Dim bh As Long
    Dim G As Long
    Dim ren As Byte
    Columns("A:A").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
                   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
                                                                                 :=xlPinYin

    Open "d:\peng.txt" For Output As #1
    Z = [A65536].End(xlUp).Row
    arr1 = Range("a1", Cells(Z, 1))

    x = Cells(1, 2)
    For i = 1 To Z
        arr(i, 1) = arr1(i, 1)
        sum1 = sum1 + arr(i, 1)
        If sum1 <= x / 4 Then ren = i
    Next i
    c = 0
    cc = 3
    sum1 = 0
    Do While arr(Z + 1, 2) < 1
        Do While sum1 < x
            sum2 = sum1
            For i = 1 To 11
                If x <= sum2 + arr(i, 1) Then
                    arr(i, 2) = 1
                    sum1 = sum1 + arr(i, 1)
                    If i > bh Then bh = i          '找出变化的量，从而知道从那里开始相加
                    Exit For
                End If

                If arr(i, 2) = 1 Then
                    arr(i, 2) = 0
                    sum1 = sum1 - arr(i, 1)
                Else
                    sum2 = sum2 + arr(i, 1)
                End If
            Next i
        Loop

        If bh > G Then G = bh                    '最大数行号

        If bh > ren Then
            y = arr(G, 1)
            For i = G - 1 To ren + 1 Step -1
                If arr(i, 2) = 1 Then
                    y = y & "+" & arr(i, 1)
                End If
            Next i
        End If

        a = y
        For i = ren To 1 Step -1
            If arr(i, 2) = 1 Then a = a & "+" & arr(i, 1)
        Next i
        c = c + 1
'        Print #1, a
        bh = 1
        Do While sum1 >= x
            For i = 1 To 400
                If arr(i, 2) = 1 Then
                    arr(i, 2) = 0
                    sum1 = sum1 - arr(i, 1)
                Else
                    If sum1 < x Then
                        arr(i, 2) = 1
                        sum1 = sum1 + arr(i, 1)
                        If i > bh Then bh = i          '找出变化的量，从而知道从那里开始相加
                        If sum1 = x Then Exit Do
                        Exit For
                    End If
                End If
            Next i
        Loop
    Loop
    Close #1
   
    MsgBox "找到 " & c & " 个解! 花费" & Format(Timer - aa, "0.000s") & " 保存在 D:\peng.txt"
End Sub