jkluio668
12/6/2017 - 4:23 PM

sendto

'[1]sheet("sendto")
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
    Application.EnableEvents = False
    If ListBox1.Visible Then ListBox1.Visible = False
    If TextBox1.Visible Then TextBox1.Visible = False
    ListBox1.Clear
    k1 = fc("moveto")

    With ActiveCell
        If ActiveCell.Column = k1 And ActiveCell.row > 1 Then
            TextBox1.Top = .Top + 1
            TextBox1.Left = .Left + 1    'Cells(ActiveCell.Row, ActiveCell.Column + 1).Left
            TextBox1.Width = .Width + 1
            TextBox1.Height = .Height + 0.1
            
            If .row > ActiveWindow.VisibleRange.Rows.Count + ActiveWindow.VisibleRange.row - 5 Then
                ListBox1.Top = .Top - ListBox1.Height
            Else
             ListBox1.Height = .Height * 4
                ListBox1.Top = .Top + .Height + 1
            End If

            ListBox1.Left = .Left + .Width + 1
            ListBox1.Width = .Width * 4 - 0.5
            'TextBox1.BackColor = .Interior.Color
            TextBox1.ForeColor = .Font.Color
            TextBox1.Font.Size = .Font.Size
            TextBox1 = .Value
            TextBox1.Visible = True
            ListBox1.Visible = True

            '
            TextBox1.Activate
            TextBox1_Change

            TextBox1.SelStart = 0
            TextBox1.SelLength = 1000
        End If
    End With
    Application.EnableEvents = True
End Sub
Private Sub ComboBox1_Change()

End Sub

Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then
        If ListBox1.ListCount > 0 Then
            TextBox1.Visible = False
            If ListBox1.Text = "" Then ListBox1.ListIndex = 0
            TextBox1.TopLeftCell = Split(ListBox1, vbTab)(0)
            TextBox1.TopLeftCell(2, 1).Select
            KeyCode = 0
        End If
    End If
    If KeyCode = 27 Then 'esc
        TextBox1.Visible = False
        ListBox1.Visible = False
    End If
    
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    On Error Resume Next
    With TextBox1
        Select Case KeyCode
            Case 38 'up
                .Visible = False
                .TopLeftCell(0, 1).Select
                KeyCode = 0
            Case 13 'enter
                .TopLeftCell = Split(ListBox1.List(0), vbTab)(0)
                .TopLeftCell(2, 1).Select
                KeyCode = 0
            Case 40 'down
                ListBox1.Activate
            Case 27 'esc
                TextBox1.Visible = False
                ListBox1.Visible = False
                Selection.Select
            Case 37 'left
                .Visible = False
                .TopLeftCell(1, 0).Select
                KeyCode = 0
            Case 39 'right
                .Visible = False
                .TopLeftCell(1, 2).Select
                KeyCode = 0
        End Select
    End With
End Sub

Private Sub TextBox1_Change()
    Dim x As Range, arr, crr
    On Error Resume Next
    ListBox1.Clear
    TextBox1.TopLeftCell = TextBox1.Text
    word1 = ComboBox1.Text
    If word1 = "" Then word1 = "all_dir"
    
    If TextBox1 = "" Then Exit Sub
    kc1 = fc(word1, , "data1")
    kc1_s = convert1(kc1)
    com1 = kc1 + 2
    com1_s = convert1(com1)
    'Application.EnableEvents = False
    If Sheets("data1").FilterMode = False Then _
    Sheets("data1").Range(kc1_s & "1:" & com1_s & "1").AutoFilter '此改坐标
    Sheets("data1").Range(kc1_s & "1:" & com1_s & "1").AutoFilter Field:=3, _
    Criteria1:="*" & TextBox1 & "*"    ', SortMethod:=xlPinYin
    
    kn = 2
    For ki = 10000 To 2 Step -1
        If Cells(ki, com1) <> "" Then
        kn = ki
        Exit For
        End If
    Next

    Set x = Sheets("data1").Cells(2, com1).Resize(kn, 2).SpecialCells(xlCellTypeVisible) _
    '此处的resize的第二个参数必须为2,且com1右侧的行最好是空的,以使下面的x.areas(i)和crr在单行时,也是二维数组
    '---------
    If Not x Is Nothing Then
    ReDim arr(1 To x.Count \ x.Columns.Count)
    k = 1
        For i = 1 To x.Areas.Count '全部的不连续区域的数量,在有连续区域时,小于总行数
            crr = x.Areas(i) '处理不连续区域
            
            For j = 1 To UBound(crr)
                arr(k) = crr(j, 1) & vbTab & crr(j, 2)
                k = k + 1 'k=i+j,最终,k的值等于 x.Count \ x.Columns.Count
            Next
        Next
    ListBox1.List = arr
    'cells().resize(ubound(arr),ubound(arr,1))=arr
    End If
    '---
    '    Application.EnableEvents = True
    If Sheets("data1").FilterMode Then Sheets("data1").Range("A1:j1").AutoFilter
    '    Application.ScreenUpdating = True
End Sub

'[1]sheet("data1")
Sub comb1()
    k1 = eu(65536, 2 + 4 + 1)
    For i = 2 To k1
        Cells(i, 2 + 4 + 3) = Cells(i, 2 + 4 + 1) & vbTab & Cells(i, 2 + 4 + 2)
    Next
    '-----
    a1 = el(1, 50)
    row1 = ActiveSheet.UsedRange.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious).row
    For i = 2 To row1
        For j = 2 + 4 + 3 To a1 Step 4
            If Cells(i, j) <> "" Then Cells(i, 2 + ((j - 2) Mod 4)) = Cells(i, j) 'fill 2~5 columns
        Next
    Next
End Sub