比对做填满

cmo9020

TEST.rar (21.93 KB, 下载次数: 14)

2023-6-10 16:48 上传

点击文件名下载附件

各位导师周末愉快...遇到一个难题,
请教各位导师一下
Sheet1 A9单元格需要执行代码后,和"范本"的A列标题做比对
(因为A列的"到达"不是固定行)
所以才需要和A列比对在找到"到达"之后,判断G2或i2单元格里面那一个是有时间,
然后将"己送达"输入到单元格中做填满。

1.目前时间是在I2单元格,但执行代码后不知道怎么让反黄地方做填满
麻烦请导师们帮助一下,谢谢您们



Sub copy()
    Dim sourceSheet As Worksheet
    Dim templateSheets(1 To 3) As Worksheet
    Dim sourceRange As Range
    Dim templateRanges(1 To 3) As Range
    Dim lastRow As Long
    Dim cell As Range
    Dim headerValue As Variant
    Dim j As Long
    Dim targetColumn As Long

    Set sourceSheet = ThisWorkbook.Sheets("Sheet1")
    Set templateSheets(1) = ThisWorkbook.Sheets("范本")

   
    Set sourceRange = sourceSheet.Range("A9")
   
    For Each cell In sourceRange
        headerValue = cell.Value

        For j = 1 To 1
            Set templateRanges(j) = templateSheets(j).Range("A1:I50").Find(What:=headerValue, LookIn:=xlValues, lookat:=xlWhole)

            If Not templateRanges(j) Is Nothing Then
                If templateSheets(j).Range("G2").Value <> "NA" And templateSheets(j).Range("I2").Value <> "NA" Then

                    If IsDate(templateSheets(j).Range("G2").Value) Then
                        targetColumn = 6
                    ElseIf IsDate(templateSheets(j).Range("I2").Value) Then
                        targetColumn = 8
                    End If
                ElseIf templateSheets(j).Range("G2").Value <> "NA" Then
                    targetColumn = 6
                ElseIf templateSheets(j).Range("I2").Value <> "NA" Then
                    targetColumn = 8
                End If
               
                Dim targetCell As Range
                Set targetCell = templateSheets(j).Cells(templateRanges(j).Row, targetColumn)
               
                If targetCell.MergeCells Then
                    Set targetCell = targetCell.MergeArea.Cells(1)
                End If
               
                Select Case j
                    Case 1
                        targetCell.Value = cell.Offset(0, 1).Value

                End Select
            End If
        Next j
    Next cell

    Set sourceRange = Nothing
    Set sourceSheet = Nothing
    For j = 1 To 3
        Set templateRanges(j) = Nothing
        Set templateSheets(j) = Nothing
    Next j
   

End Sub

ykcbf1100

这应该是Ai写的吧。

cmo9020

ykcbf1100 发表于 2023-6-11 10:33
这应该是Ai写的吧。

对,目前己经改好,不过代码很长
而且和AI沟通要沟通有点久....


Sub TEST()
    Dim sourceSheet As Worksheet
    Dim templateSheets(1 To 3) As Worksheet
    Dim sourceRange As Range
    Dim templateRanges(1 To 3) As Range
    Dim lastRow As Long
    Dim cell As Range
    Dim headerValue As Variant
    Dim j As Long
    Dim targetColumn As Long

    Set sourceSheet = ThisWorkbook.Sheets("Sheet1")
    Set templateSheets(1) = ThisWorkbook.Sheets("范本")
    Set sourceRange = sourceSheet.Range("A9")

    For Each cell In sourceRange
        headerValue = cell.Value

        For j = 1 To 1
            Set templateRanges(j) = templateSheets(j).Range("A1:I50").Find(What:=headerValue, LookIn:=xlValues, LookAt:=xlWhole)

            If Not templateRanges(j) Is Nothing Then
                If templateSheets(j).Range("G2").Value <> "NA" And templateSheets(j).Range("I2").Value <> "NA" Then
                    If IsDate(templateSheets(j).Range("G2").Value) Then
                        targetColumn = 6
                    ElseIf IsDate(templateSheets(j).Range("I2").Value) Then
                        targetColumn = 8
                    End If
                ElseIf templateSheets(j).Range("G2").Value <> "NA" Then
                    targetColumn = 6
                ElseIf templateSheets(j).Range("I2").Value <> "NA" Then
                    targetColumn = 8
                End If

                Dim targetCells As Range
                Set targetCells = templateRanges(j).MergeArea

                For Each targetCell In targetCells
                    If targetCell.MergeCells Then
                        For Each mergedCell In targetCell.MergeArea
                            Select Case j
                                Case 1
                                    mergedCell.Offset(0, targetColumn - 1).Value = sourceSheet.Cells(cell.Row, cell.Column + 1).Value
                            End Select
                        Next mergedCell
                    Else
                        Select Case j
                            Case 1
                                targetCell.Offset(0, targetColumn - 1).Value = sourceSheet.Cells(cell.Row, cell.Column + 1).Value
                        End Select
                    End If
                Next targetCell
            End If
        Next j
    Next cell

    Set sourceRange = Nothing
    Set sourceSheet = Nothing
    For j = 1 To 3
        Set templateRanges(j) = Nothing
        Set templateSheets(j) = Nothing
    Next j

End Sub

准提部林

幾行即可解決,
B8的 "08:50" 做何用???

准提部林

手寫的, 不是AI

Sub TEST_A1()
Dim T1$, T2$, F As Range
T1 = [Sheet1!a9]: T2 = [Sheet1!b9]
With Sheets("范本")
     If IsDate(.[g2].Text) Or IsDate(.[i2].Text) Then
        Set F = .[a:a].Find(T1, Lookat:=xlWhole)
        If Not F Is Nothing Then F.MergeArea.Resize(, 8).Columns(8) = T2
     End If
End With
End Sub

注意//合併格不能直接使用offset, 它只會抓第一格, 這AI不會知道!!!

cmo9020

准提部林 发表于 2023-6-11 18:00
手寫的, 不是AI

Sub TEST_A1()

谢谢导师,ai好像没办法写这么简短
每次都写超长的....