excel 在所有的VBA中检查一个列,看看它是否与输入表VBA匹配,并调用一个新的宏

hjqgdpho  于 7个月前  发布在  其他
关注(0)|答案(2)|浏览(82)

我有2个关键表表1和表2.从表2 -列B,基于唯一的值,多个新的数据库创建与表名称的基础上列值(为此,代码完成)对于所有新创建的表
1.插入2个新行,并在S2和R3中提供值
1.此外,我需要检查由用户在表1的D2提供的日期对所有的日期在新创建的列我的数据
1.如果日期匹配,则调用宏10,如果不显示错误,说“工作表名称”中的日期不匹配。是否仍要运行宏10。如果用户说是,则运行宏10,如果不结束子
我已经开始代码如下,但我坚持点2和3

Dim ws as Worksheet
    Dim lastrow As Long
    For Each ws in ActiveWorkbook.Worksheets
    If ws.Name <> "Sheet1" And ws.Name <> "Sheet2" Then
    With ws
    .Rows("1:2").Insert
    .Range ("S2") = "OB"
    .Range ("R3") = "AD"

字符串
有谁能帮我一下我该怎么办

zzlelutf

zzlelutf1#

你可以以此为基础

Option Explicit

Sub HelpHer()

    Dim lastrow As Long
    Dim ws As Worksheet
    
    With ActiveWorkbook
    
        Dim refDate As Date
            refDate = .Worksheets("Sheet1").Range("D2").Value
            
            For Each ws In .Worksheets
            
                Select Case ws.Name
                    Case "Sheet1", "Sheet2"
                    
                    Case Else

                        With ws
                        
                            .Rows("1:2").Insert
                            .Range("S2") = "OB"
                            .Range("R3") = "AD"
                            
                            Dim foundCel As Range
                                Set foundCel = Intersect(.UsedRange, .Range("I:I")).Find(what:=refDate, LookIn:=xlValues, lookat:=xlWhole)
                                
                                Dim okRun As Boolean
                                    Select Case True
                                        Case Not foundCel Is Nothing
                                            okRun = True
                                            
                                        Case MsgBox("date mismatch in sheet '" & .Name & "'" _
                                                    & vbCrLf & vbCrLf & "Do you still want to run macro 10?", _
                                                    vbYesNo) = vbYes
                                            okRun = True
                                            
                                        Case Else
                                            okRun = False
                                    End Select
                                          
                                        If okRun Then
                                            'run your macro
                                        End If
                                                        
                        End With
                
                End Select
            
            Next
        
    End With
        

End Sub

字符串

alen0pnh

alen0pnh2#

请试试看。

Option Explicit

Sub demo()
    Dim ws As Worksheet
    Dim sDate, c As Range
    Dim bMatch As Boolean, sMsg As String
    Const KEY_COL = "I"
    Const START_ROW = 2 ' Modify as needed, the first date in colum I
    sDate = Sheets("Sheet1").Range("D2").Value
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "Sheet1" And ws.Name <> "Sheet2" Then
            bMatch = True
            With ws
                .Rows("1:2").Insert
                .Range("S2") = "OB"
                .Range("R3") = "AD"
                For Each c In .Range(.Cells(START_ROW, KEY_COL), .Cells(.Rows.Count, KEY_COL).End(xlUp))
                    If Not c.Value = sDate Then
                        bMatch = False
                        Exit For
                    End If
                Next
                If bMatch Then
                    Call Macro10
                Else
                    sMsg = "Date mismatch in " & .Name & "." & _
                        vbNewLine & "Do you still want to run macro 10?"
                    If MsgBox(sMsg, vbYesNo) = vbYes Then Call Macro10
                End If
            End With
        End If
    Next
End Sub

字符串

相关问题