Question

我有一个名为“里程碑”的电子表格，其中包含一个表格，其中描述了里程碑和完成里程碑的日期。

我正在尝试创建一个宏，当电子表格“里程碑”被停用时，该宏：

1）在电子表格“里程碑”中查看里程碑列表

2）如果里程碑已完成（=完成），则宏将在另一个名为“ Datasheet_Complete”的电子表格中复制里程碑的描述和日期。

3）按日期对里程碑进行排序

我不知道我的代码出了什么问题，但是似乎“排序”功能无法正常工作。复制/粘贴部分正在工作这是代码，您能帮我吗？

非常感谢！

Private Sub Worksheet_Desactivate()
Dim i           As Integer
Dim j           As Integer
Dim h           As Integer
Dim TxtInColA   As String
Dim TxtInColB   As String
Dim TxtInColC   As String
Dim TxtInColA1  As String
Dim TxtInColB1  As String
Dim TxtInColC1  As String
Dim TxtInColD   As String
Dim TxtInColE   As String
Dim EndRow1     As Integer
Dim Range1      As String
Dim RangeA      As Range

For i = 2 To 20
TxtInColA = ThisWorkbook.Sheets("Milestones").Cells(i, 1).Value
TxtInColB = ThisWorkbook.Sheets("Milestones").Cells(i, 2).Value
TxtInColC = ThisWorkbook.Sheets("Milestones").Cells(i, 3).Value
TxtInColA1 = ThisWorkbook.Sheets("Milestones").Cells(i - 1, 1).Value
TxtInColB1 = ThisWorkbook.Sheets("Milestones").Cells(i - 1, 2).Value
TxtInColC1 = ThisWorkbook.Sheets("Milestones").Cells(i - 1, 3).Value

If StrComp(TxtInColA, "", vbTextCompare) = 0 _
    And StrComp(TxtInColB, "", vbTextCompare) = 0 _
    And StrComp(TxtInColC, "", vbTextCompare) = 0 _
    And StrComp(TxtInColA1, "", vbTextCompare) <> 0 _
    And StrComp(TxtInColB1, "", vbTextCompare) <> 0 _
    And StrComp(TxtInColC1, "", vbTextCompare) <> 0 _
Then
    j = i - 1
End If
Next i


'copy milestones in a seperate sheet
h = 0
q = 0
ThisWorkbook.Sheets("Datasheet_Completed").Range("A1:B1000").ClearContents
ThisWorkbook.Sheets("Datasheet_Next").Range("A1:B1000").ClearContents
Selection.Clear
    For i = 2 To j
    TxtInColB = ThisWorkbook.Sheets("Milestones").Cells(i, 2).Value
    TxtInColD = ThisWorkbook.Sheets("Milestones").Cells(i, 4).Value
    TxtInColE = ThisWorkbook.Sheets("Milestones").Cells(i, 5).Value
        If StrComp(TxtInColE, "Yes", vbTextCompare) = 0 Then
            h = h + 1
            ThisWorkbook.Sheets("Datasheet_Completed").Cells(h, 1).Value = TxtInColD
            ThisWorkbook.Sheets("Datasheet_Completed").Cells(h, 2).Value = TxtInColB

        End If
Next i
EndRow1 = CStr(h)
Range1 = "A2" & ":" & "A" & EndRow1
Set RangeA = ThisWorkbook.Sheets("Datasheet_Completed").Range(Range1)



ThisWorkbook.Sheets("Datasheet_Completed").Sort.SortFields.Clear
    ThisWorkbook.Sheets("Datasheet_Completed").Sort.SortFields.Add Key _
    :=RangeA, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
    :=xlSortTextAsNumbers
    With ThisWorkbook.Sheets("Datasheet_Completed").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


End Sub

停用工作表时，按未激活工作表中的日期排序

0 个答案: