excel 当文件名中的日期每天变化时引用文件

hec6srdp  于 2023-10-22  发布在  其他
关注(0)|答案(2)|浏览(135)

所有单元格位置保持不变,唯一改变的是文件名中的日期。
我正在从一个Excel工作簿剪切并粘贴到另一个工作簿。
当文件名每天都在更改时,我如何执行所需的功能?

ActiveWindow.SmallScroll Down:=108
Windows("Standard 15OCT23.csv").Activate
Range("A2:H17").Select
Selection.Cut
Windows("Generic 15OCT23.csv").Activate
Rows("122:122").Select
Selection.Insert Shift:=xlDown
ActiveWindow.SmallScroll Down:=141

更新
我今天来上班,试图在今天的报告上运行这个,它不会工作。在对代码进行了一些重大编辑之后。我有一个应该工作的代码,但它就是不想合作。

Sub StandardToGenericDataXfer()
    Dim sDate As String
    sDate = UCase(format(Date, "ddMMMyy")) ' Format the current date

    Dim standardWorkbook As Workbook
    Dim genericWorkbook As Workbook
    Dim wb As Workbook

    ' Loop through open workbooks
    For Each wb In Workbooks
        Dim wbName As String
        wbName = UCase(wb.Name)
        If (InStr(wbName, "STANDARD") > 0 Or InStr(wbName, "GENERIC") > 0) And _
           InStr(wbName, sDate) > 0 And InStr(wbName, ".CSV") > 0 Then
            If InStr(wbName, "STANDARD") > 0 Then
                Set standardWorkbook = wb
            ElseIf InStr(wbName, "GENERIC") > 0 Then
                Set genericWorkbook = wb
            End If
        End If
    Next wb

    ' Check if both workbooks were found
    If Not (standardWorkbook Is Nothing) And Not (genericWorkbook Is Nothing) Then
        ' Copy data from standardWorkbook to genericWorkbook
        standardWorkbook.Sheets(standardWorkbook.Name).Range("A2:H16").Copy
        genericWorkbook.Sheets(genericWorkbook.Name).Range("A122").Insert Shift:=xlDown
' More Copy/Insert commands here
MsgBox "Data transfer complete.", vbInformation
    Else
        Dim message As String
        message = "One or both workbooks not found:" & vbCrLf
        If Not standardWorkbookFound Then message = message & "Standard workbook not found." & vbCrLf
        If Not genericWorkbookFound Then message = message & "Generic workbook not found."
        MsgBox message, vbExclamation
    End If
End Sub

我没有遇到的问题是,即使我打开了两个文件,例如“Generic 15OCT23”和“Standard 15OCT23”,我的JavaScript代码现在也无法找到打开的文件。

m528fe3b

m528fe3b1#

  • Date函数提供当前系统日期。
  • Format函数使用所需的日期格式将日期转换为字符串。
  • 然后将结果日期字符串与文件名连接在一起。
Dim sDate As String
    sDate = UCase(Format(Date, "ddMMMyy"))
    ActiveWindow.SmallScroll Down:=108
    Windows("Standard " & sDate & ".csv").Activate
    Range("A2:H17").Cut
    Windows("Generic " & sDate & ".csv").Activate
    Rows("122:122").Insert Shift:=xlDown
    ActiveWindow.SmallScroll Down:=141
  • Microsoft文档:*

Date function
Format function
顺便说一句,这篇文章绝对值得阅读。
How to avoid using Select in Excel VBA
代码可以简化如下。顺便说一句,Cut w/o Paste不做任何更改。

Dim sDate As String
sDate = UCase(Format(Date, "ddMMMyy"))
Workbooks("Standard " & sDate & ".csv").Range("A2:H17").Cut
Workbooks("Generic " & sDate & ".csv").Rows(122).Insert Shift:=xlDown
yqkkidmi

yqkkidmi2#

标识打开的工作簿

  • 如果可以确保仅打开“匹配”工作簿(具有相同日期的工作簿),则可以使用以下命令:
Sub CutInsertRange()

    Dim wb As Workbook, swb As Workbook, dwb As Workbook

    For Each wb In Workbooks
        If LCase(wb.Name) Like "standard *.csv" Then
            Set swb = wb
        ElseIf LCase(wb.Name) Like "generic *.csv" Then
            Set dwb = wb
        End If
    Next wb
    
    If swb Is Nothing Then
        MsgBox "Standard workbook not found!", vbExclamation
        Exit Sub
    Else
        If dwb Is Nothing Then
            MsgBox "Generic workbook not found!", vbExclamation
            Exit Sub
        End If
    End If
    
    swb.Sheets(1).Range("A2:H17").Cut
    dwb.Sheets(1).Rows("122").Insert Shift:=xlShiftDown

End Sub

相关问题