循環代碼多次運行宏

我有這個vba宏，它從文本文件中提取數據並將其放入Excel中的一列。這些文件以天（2016mmdd）命名。目前，我每天都運行這個宏。現在我希望它能夠在運行這個宏的時候，宣佈的月份中的所有日期（比如說八月份）的數據將被自動提取到不同的列中（每月的每一天一列）。因此，如果本月有31天，我將不必手動運行31次。感謝您的幫助。循環代碼多次運行宏

Sub Macro7() 
' 
' Macro7 Macro 
' 
' Keyboard Shortcut: Ctrl+x 
' 

Dim fileDate, rng, rng1, rng2, rng3, rcell As String 

b = InputBox("Enter file Name mmdd", "File name") 
rcell = InputBox("Enter cell reference", "Reference name") 

rng = "$" & rcell & "$2" 
rng1 = rcell & "2:" & rcell & "14" 
rng2 = rcell & "52:" & rcell & "62" 
rng3 = rcell & "2:" & rcell & "101" 

Filename = "j:\files\2016" & b & "2259.txt" 

    With ActiveSheet.QueryTables.Add(Connection:= _ 
     "TEXT;j:\files2016" & b & "2259.txt", Destination:= _ 
     Range(rng)) 

     .Name = "tr" & b 
     .FieldNames = True 
     .RowNumbers = False 
     .FillAdjacentFormulas = False 
     .PreserveFormatting = True 
     .RefreshOnFileOpen = False 
     .RefreshStyle = xlInsertDeleteCells 
     .SavePassword = False 
     .SaveData = True 
     .AdjustColumnWidth = True 
     .RefreshPeriod = 0 
     .TextFilePromptOnRefresh = False 
     .TextFilePlatform = 850 
     .TextFileStartRow = 1 
     .TextFileParseType = xlFixedWidth 
     .TextFileTextQualifier = xlTextQualifierDoubleQuote 
     .TextFileConsecutiveDelimiter = False 
     .TextFileTabDelimiter = True 
     .TextFileSemicolonDelimiter = False 
     .TextFileCommaDelimiter = False 
     .TextFileSpaceDelimiter = False 
     .TextFileColumnDataTypes = Array(9, 1, 9) 
     .TextFileFixedColumnWidths = Array(103, 4) 
     .TextFileTrailingMinusNumbers = True 
     .Refresh BackgroundQuery:=False 
    End With 

    Range(rng1).Select 
    Selection.Delete Shift:=xlUp 
    ActiveWindow.SmallScroll Down:=45 
    Range(rng2).Select 
    Selection.Delete Shift:=xlUp 
    ActiveWindow.SmallScroll Down:=-60 
    Range(rng3).Select 
End Sub

來源

2016-09-15 MordC

你用'for-loop'標記了這個......你有沒有試過用過嗎？如果我理解正確，你想運行宏'b =「0801」... b =「0831」'？ – arcadeprecinct

不是真的，@arcadeprecinct。這個宏在用戶輸入日期和excel列（比如a，b，c或d）和他/她必須每天都這樣做之後從文本文件中提取數據。現在，我希望它只有一個月將被輸入並且所有日期的數據將被提取到Excel工作表的不同列中。謝謝。 – MordC

快速方法是重寫Sub Macro7（）以接受參數，例如，

Sub ImportFiles(FName As String, ColNum As Integer) 

    ' blablabla 

    ' work with range objects ... not with patched strings containing range addresses 
    Dim Rng As Range, Rng1 As Range, Rng2 As Range, Rng3 As Range 

    Set Rng = Cells(2, ColNum) 
    Set Rng1 = Range(Cells(2, ColNum), Cells(14, ColNum)) 
    Set Rng2 = Range(Cells(52, ColNum), Cells(62, ColNum)) 
    Set Rng3 = Range(Cells(2, ColNum), Cells(101, ColNum)) 

    Filename = "j:\files\2016" & FName & "2259.txt" 

    ' and replace <Destination := Range(Rng)> by <Destination := Rng> 

    ' blablabla 

    ' use the range objects defined/set earlier ... save on Select/Selection 
    Rng1.Delete xlUp 
    Rng2.Delete xlUp 
    Rng3.Select 


End Sub

並且具有呼叫宏例如

Sub DoWorklist() 

    ImportFiles "0901", 1 
    ImportFiles "0902", 2 
    ImportFiles "0903", 3 
    ' blablabla 

    'alternative 

    Dim Idx As Integer 

    For Idx = 1 To 30 
     ' to overcome well spotted chr() issue we convert running number Idx 
     ' into 2 digit string with leading "0" 
     ImportFiles "09" & Format(Idx, "00"), Idx 
    Next Idx 


End Sub

來源

2016-09-15 10:39:32 MikeD

該替代方法僅適用於'Idx = 1到26'。 'Chr（91）'將返回'['而不是'AA'。 –

True * shameonme * – MikeD

@MikeD感謝您的幫助 – MordC

循環代碼多次運行宏

回答

相關問題