[英]Double Clicking header to sort with merged cells VBA
I have a sheet where i have headers for columns in Row 4. I had a code that when i double clicked on a cell in row 4 it sorted the data by that cell.我有一张工作表,其中第 4 行的列有标题。我有一个代码,当我双击第 4 行中的一个单元格时,它会按该单元格对数据进行排序。 The problem i have now is that in Column B, the cells are merged with the row below.我现在的问题是在 B 列中,单元格与下面的行合并。 So, for example row 4 and 5 are merged, row 6 and 7 etc. The code i have will no longer let me sort, due to these merged cells.因此,例如第 4 行和第 5 行合并,第 6 行和第 7 行等。由于这些合并的单元格,我拥有的代码将不再让我排序。 Can anyone help?任何人都可以帮忙吗?
Here is the code that i was using这是我使用的代码
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
lr = Cells(Rows.Count, "B").End(xlUp).row
lc = Cells(4, Columns.Count).End(xlToLeft).Column
If Target.row = 4 And Target.Column <= lc Then Range(Cells(4, "B"), Cells(lr, lc)).Sort Key1:=Cells(4, Target.Column), Header:=xlYes 'Order1:=xlDescending
End Sub
try尝试
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim lc As Integer
lc = Cells(4, Columns.Count).End(xlToLeft).Column
If Target.Row = 4 And Target.Column <= lc Then
sortdescent Target.Column - 1, lc
End If
End Sub
module code模块代码
Sub sortdescent(x As Integer, col As Integer)
Dim vDB
Dim strTemp()
Dim r As Integer, c As Integer, i As Integer, j As Integer
Dim m As Integer
ReDim strTemp(1 To 2, 1 To col)
vDB = Range("b5", Cells(Range("c" & Rows.Count).End(xlUp).Row, col))
r = UBound(vDB, 1)
c = UBound(vDB, 2)
For i = 1 To r Step 2
For j = 1 To r Step 2
'If vDB(j, x) > vDB(i, x) Then 'Ascent
If vDB(j, x) < vDB(i, x) Then 'Descent
For m = 1 To c
strTemp(1, m) = vDB(i, m)
strTemp(2, m) = vDB(i + 1, m)
vDB(i, m) = vDB(j, m)
vDB(i + 1, m) = vDB(j + 1, m)
vDB(j, m) = strTemp(1, m)
vDB(j + 1, m) = strTemp(2, m)
Next
End If
Next j
Next i
Range("b5").Resize(r, c) = vDB
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.