Question

我有这段代码，他们在几个单元格（A列）中以大文本搜索日期。问题是有时约会的数量可以达到400！我不能为400个值重复此代码！

代码的目的是：

Find("Date d'Evaluation(1):"), copy/past in B5 (-22 car)
Find("Date d'Evaluation(2):"), copy/past in C5 (-22 car)
Find("Date d'Evaluation(3):"), copy/past in D5 (-22 car)
…
…

代码是：

Dim Date1 As Range
Dim Date2 As Range
Dim Date3 As Range

''''''' trouver les dates d'observation
Set Date1 = Worksheets("Sheet1").Range("A1:A500").Find("Date d'Evaluation(1):")
Worksheets("Sheet2").Range("B5").Value = Date1.Value
Worksheets("Sheet2").Range("B5").Value = Right(Date1.Value, Len(Date1.Value) - 22) 'enelve le surplu

Set Date2 = Worksheets("Sheet1").Range("A1:A500").Find("Date d'Evaluation(2):")
Worksheets("Sheet2").Range("C5").Value = Date2.Value
Worksheets("Sheet2").Range("C5").Value = Right(Date2.Value, Len(Date2.Value) - 22) 'enelve le surplu

Set Date3 = Worksheets("Sheet1").Range("A1:A500").Find("Date d'Evaluation(3):")
Worksheets("Sheet2").Range("D5").Value = Date3.Value
Worksheets("Sheet2").Range("D5").Value = Right(Date3.Value, Len(Date3.Value) - 22) 'enelve le surplu

在Google上搜索后，主要问题是：

我可以循环Dim Date(n) As range吗？
我可以循环直到找不到它（“ Date d'Evaluation（n）：”）吗？然后停下来循环...

Answer 1

您可以一次完成所有操作。循环运行直到什么都没有找到：

Option Explicit

Sub ProcedureName()
    Dim RangeToSearch As Range
    Set RangeToSearch = Worksheets("Sheet1").Range("A1", Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp))

    Dim i As Long
    i = 1
    Do
        Dim FoundRange As Range
        Set FoundRange = RangeToSearch.Find(What:="Date d'Evaluation(" & i & "):", LookAt:=xlPart)

        If Not FoundRange Is Nothing Then
            Dim FoundDate As Variant
            FoundDate = Split(Right$(FoundRange.Value, Len(FoundRange.Value) - 22), "/")

            Worksheets("Sheet2").Range("B5").Offset(ColumnOffset:=i - 1).Value = DateSerial(FoundDate(2), FoundDate(1), FoundDate(0))
        End If

        i = i + 1
    Loop Until FoundRange Is Nothing
End Sub

请注意，LookAt:=xlPart方法中必须包含Find。否则，Excel将使用Excel上次使用的方法（而且您永远都不会知道它是哪一种）。

我使用Split将找到的日期（例如02/04/2024）拆分为一个数组：

FoundDate(0) = "02"
FoundDate(1) = "04"
FoundDate(2) = "2024"

因此我们可以使用DateSerial

将其转换为实际日期

DateSerial(FoundDate(2), FoundDate(1), FoundDate(0)) for DD/MM/YYYY
DateSerial(FoundDate(2), FoundDate(0), FoundDate(1)) for MM/DD/YYYY

Answer 2

嗯...我的帖子几乎与Pᴇʜ的帖子相同。哦，好吧，我确实做了一些曲折。

LookAt:=xlPart是必需的，以便find将搜索单元格的部分值。我使用LookIn:=xlValues是因为我使用公式构造了数据集。

这个想法是将所有找到的值添加到ArrayList中，然后通过一次操作将它们写回到Sheet2中。

Sub UpdateDEvaluation()
    Dim list As Object, Found As Range, Source As Range
    Dim n As Long

    With Worksheets("Sheet1")
        Set Source = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
    End With

    Set list = CreateObject("System.Collections.ArrayList")

    Do
        n = n + 1

        Set Found = Source.Find(What:="Date d'Evaluation(" & n & "):", LookAt:=xlPart, LookIn:=xlValues)

        If Not Found Is Nothing Then
            list.Add Right(Found.Value, Len(Found.Value) - 22)
        End If

    Loop Until Found Is Nothing

    If list.Count > 0 Then
        Worksheets("Sheet2").Range("D5").Resize(1, list.Count).Value = list.ToArray
    End If

End Sub

Answer 3

如何处理以下内容，它最多可循环400次，如果什么也没发现，则停止循环：

Sub foo()
Dim Date1 As Range
For i = 1 To 400
    FindValue = "Date d'Evaluation(" & i & "):"
''''''' trouver les dates d'observation
    Set Date1 = Worksheets("Sheet1").Range("A1:A500").Find(What:=FindValue, LookAt:=xlPart)
    If Not Date1 Is Nothing Then
        Worksheets("Sheet2").Cells(5, i + 1).Value = Right(Date1.Value, Len(Date1.Value) - 22) 'enelve le surplu
    Else
        Exit For
    End If
Next i
End Sub

循环查找功能

3 个答案: