ฉันรู้ว่าฉันใช้ SuperUser และไม่ได้อยู่ใน StackOverflow แต่การแก้ไขปัญหานี้สามารถพบได้ในการใช้รหัส VBA ใน Excel 2016
ฉันมีปัญหาที่คล้ายกัน (ซับซ้อนกว่า)
ฉันต้องการเพิ่มตัวกรองบางตัวในคอลัมน์ที่ชัดเจน แต่ไม่ได้อยู่ในแถวที่ 1 เฉพาะในแถวที่ 2 เท่าที่คุณเห็นในการติดตามหน้าจอ
ฉันได้ลองใช้ Excel GUI แต่ดูเหมือนว่าเป็นไปไม่ได้ดังนั้นฉันจึงเขียนโค้ดต่อไปนี้:
'********************************************************
'* SetFilter()
'********************************************************
'* PUBLIC method to call to define CUSTOM AutoFilter
'* on complex header.
'********************************************************
Sub SetFilter()
'Compute last row number
Dim nLast As Long
nLast = Range("A" & Rows.Count).End(xlUp).Row
'Lock screen update
Application.ScreenUpdating = False
'Unmerge merged cells to allow adding filter
Range("A1:A2").MergeCells = False
Range("B1:B2").MergeCells = False
Range("C1:C2").MergeCells = False
Range("D1:D2").MergeCells = False
Range("E1:E2").MergeCells = False
Range("F1:F2").MergeCells = False
'Add filter on row 2 and not 1
Range("A2:Z" & nLast).Select
Selection.AutoFilter
'Remove (or Hide) filter combobox for some columns
Selection.AutoFilter Field:=GetColumnIndex("C"), VisibleDropDown:=False
Selection.AutoFilter Field:=GetColumnIndex("G"), VisibleDropDown:=False
Selection.AutoFilter Field:=GetColumnIndex("H"), VisibleDropDown:=False
'Merge unmerged cells to restore previous state
Range("A1:A2").MergeCells = True
Range("B1:B2").MergeCells = True
Range("C1:C2").MergeCells = True
Range("D1:D2").MergeCells = True
Range("E1:E2").MergeCells = True
Range("F1:F2").MergeCells = True
'Unlock screen update
Application.ScreenUpdating = True
End Sub
'********************************************************
'* GetColumnIndex()
'********************************************************
'* return column's index from column letters
'********************************************************
Function GetColumnIndex(sColLetter As String) As Integer
Dim n As Integer: n = 0
Dim iMax As Integer: iMax = Len(sColLetter)
Dim i As Integer
Dim sChar As String
Dim c As Integer
For i = 1 To iMax
sChar = Mid(sColLetter, i, 1)
c = 1 + Asc(sChar) - Asc("A")
n = n * 26 + c
Next
If n = 1 Then
n = 1
End If
GetColumnIndex = n
End Function
ตรรกะของรหัสนี้คือ
A. Unmerge ผสานเซลล์ส่วนหัวในแนวตั้งเพื่ออนุญาตให้เพิ่มตัวกรองในแถว 2
Range("A1:A2").MergeCells = False
ไม่มีการรวมเซลล์ A1 และ A2
B. เพิ่มตัวกรองอัตโนมัติในเซลล์ทั้งหมดของแถวที่ 2
Range("A2:Z" & nLast).AutoFilter
ตัวกรองอัตโนมัติถูกสร้างขึ้นสำหรับเซลล์ในทุกแถวยกเว้นแถว 1
C. ลบหรือซ่อนตัวกรอง Combobox สำหรับบางคอลัมน์
Selection.AutoFilter Field:=GetColumnIndex("C"), VisibleDropDown:=False
ซ่อน DropBox ของคอลัมน์ "C"
D. ผสานเซลล์ที่ไม่ได้ผสานเพื่อคืนค่าสถานะเดิม
Range("A1:A2").MergeCells = True
เซลล์ A1 และ A2 จะรวมกันอีกครั้ง