'[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