excel 获取相邻单元格的值并粘贴到主工作表中

mwg9r5ms  于 2023-11-20  发布在  其他
关注(0)|答案(1)|浏览(165)


附件是示例数据文件的2个屏幕截图。一个是控件,另一个是工作表。可能有几个名称,但所有名称都在控件中。3 ] 3我有一个主表称为控制和其他几个控制表。控制表看起来像这样第3行有日期第4行有单词打开和关闭。对打开和关闭有1日期

Date 1.    Date 1. Date 2.  Date 2
       Opening.  Closing  Opening. Closing

字符串
ABCDEFGH是2个字符串,但字符串的数量可能每天都在变化。在这两个工作表中有一个字符串叫做Closing。相邻的值有一个数字,需要进入控制表匹配的日期以及。日期也在工作表中总是在每个工作表的e4中,工作表名称也存在于每个工作表的e3中。我尝试的是下面,但我无法继续下去。

Dim ws as Worksheet
        Dim lastrow as Long
        Dim Nextrow as Long
        Dim Range as Range
        Dim rFind as range

        For each ws in ActiveWorkbook.Worksheets
        If ws.Name <> "Control" then
        
        Set rFind = .Find(What:="Closing", Lookat:=xlwhole, MatchCase:=False, 
        SearchFormat:=False)

anhgbhbe

anhgbhbe1#

Option Explicit

Sub Demo()
    Dim ws As Worksheet, mainSht As Worksheet
    Dim rFind As Range, rDate As Range, rSht As Range
    Dim iDate, arrDate, arrSht
    Dim DateCnt As Long, ShtCnt As Long
    Dim i As Long, iRow As Long, iCol As Long
    Const KEYWORD = "Closing"
    Set mainSht = Sheets("Control")
    ' Load date and sheet name
    With mainSht
        arrDate = .Range("C3", .Cells(3, .Columns.Count).End(xlToLeft)).Value
        DateCnt = UBound(arrDate, 2)
        arrSht = .Range("B5", .Cells(.Rows.Count, 2).End(xlUp)).Value
        ShtCnt = UBound(arrSht)
    End With
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "Control" Then
            ' Search KEYWORD
            Set rFind = ws.Cells.Find(What:=KEYWORD, LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
            If Not rFind Is Nothing Then
                iDate = ws.Range("E4").Value
                ' Validate E4 is Date
                If IsDate(iDate) Then
                    iRow = 0: iCol = 0
                    ' Match date in row 3
                    For i = 1 To DateCnt
                        If arrDate(1, i) = iDate Then
                            iCol = i + 3
                            Exit For
                        End If
                    Next i
                    If iCol > 0 Then
                        ' Match sheet name in Column B
                        For i = 1 To ShtCnt
                            If arrSht(i, 1) = ws.Name Then
                                iRow = i + 4
                                Exit For
                            End If
                        Next i
                        If iRow > 0 Then
                            ' Populate Control sheet
                            mainSht.Cells(iRow, iCol).Value = rFind.Offset(0, 1)
                        End If
                    End If
                End If
            End If
        End If
    Next ws
End Sub

字符串

相关问题