我正在使用此代碼來自動化匯入（更像是復制資料）和檔案（以及檔案中的作業表）上的一些輕型格式，我可以（必須）每天生成這些格式。
在運行此代碼之前，我所做的是轉到新檔案/關系所在的檔案夾/路徑。此檔案名總是不同，但至少以 _pr11* 開頭，所以它看起來像這樣“_pr11（一些數字）。 xlsx" 我打開這個檔案，比另存為"PR11.xlsx" 到另一個路徑。
所以我要歸檔的是一些代碼，它可以根據檔案進入檔案夾的時間獲取最新檔案，也可以根據其他邏輯確定哪個檔案是最新的檔案。
我確實有另一種方法，即查看檔案并查看哪些行更少或更多行（列始終相同且永不更改）但這不是一種聰明的方法，因為行的總數可以更少一天和更多的第二天。所以我想方法不是正確的方法..
Sub ImportData()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set closedBook = Workbooks.Open("C:\Temp\PR11.xlsx")
closedBook.Sheets("Analyse").Copy After:=ThisWorkbook.Sheets("PR11_P3")
closedBook.Close SaveChanges:=False
Sheets("Analyse").Select
Columns("AC:AE").Delete
Columns("O:Q").Delete
Columns("I:M").Delete
Columns("E:G").Delete
Columns("A:B").Delete
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("PR11_P3").Select
Range("A10").Select
ActiveSheet.Paste
Sheets("Analyse").Delete
Dim Table As ListObject
Set Table = ActiveSheet.ListObjects.Add(xlSrcRange, _
Range("A10").CurrentRegion, , xlYes)
With Table
.Name = "PR11_P3_Tabell"
End With
ActiveSheet.ListObjects("PR11_P3_Tabell").TableStyle = "TableStyleMedium5"
ActiveSheet.ListObjects("PR11_P3_Tabell").ShowTotals = False
End Sub
如果有人想知道這個潛艇的整個鱈魚是如何變成下面的。非常感謝到目前為止的幫助，非常感謝https://stackoverflow.com/users/9814069/vbasic2008
現在我確實想知道如何讓搜索功能打開一個對話框，以便可以選擇檔案 - 如果在給定路徑中找不到檔案。
即使我可以弄清楚如何在路徑的子檔案夾中搜索檔案，我認為這樣做是相當防彈的方式。
有什么建議？
Sub ImportAndFormatData()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Const sFolderPath As String = "C:\Temp\PR11\"
' Open the newest file.
Dim sFileName As String: sFileName = Dir(sFolderPath & "_pr11*.xlsx")
If Len(sFileName) = 0 Then Exit Sub ' no file found
Dim cuDate As Date, sFileDate As Date, cuPath As String, sFilePath As String
Do Until Len(sFileName) = 0
cuPath = sFolderPath & sFileName
cuDate = FileDateTime(cuPath)
'Debug.Print "Current: " & cuDate & " " & cuPath ' print current
If cuDate > sFileDate Then
sFileDate = cuDate
sFilePath = cuPath
End If
sFileName = Dir
Loop
'Debug.Print "Result: " & sFileDate & " " & sFilePath ' print result
' See in the VBE Immediate window 'CTRL G' what was checked
' and what was determined to open.
' When done testing, out-comment or delete the two 'Debug.Print' lines.
Dim closedBook As Workbook: Set closedBook = Workbooks.Open(sFilePath)
closedBook.Sheets("Analyse").Copy After:=ThisWorkbook.Sheets("PR11_P3")
closedBook.Close SaveChanges:=False
Sheets("Analyse").Select
Columns("AC:AE").Delete
Columns("O:Q").Delete
Columns("I:M").Delete
Columns("E:G").Delete
Columns("A:B").Delete
Sheets("Analyse").Move After:=Workbooks("PR11_P3.xlsm").Sheets(1)
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("PR11_P3").Select
Range("A10").Select
ActiveSheet.Paste
Sheets("Analyse").Delete
Dim Table As ListObject
Set Table = ActiveSheet.ListObjects.Add(xlSrcRange, _
Range("A10").CurrentRegion, , xlYes)
With Table
.Name = "PR11_P3_Tabell"
End With
ActiveSheet.ListObjects("PR11_P3_Tabell").TableStyle = "TableStyleMedium5"
ActiveSheet.ListObjects("PR11_P3_Tabell").ShowTotals = False
Cells.Select
Selection.Borders.LineStyle = xlLineStyleNone
Selection.Borders.LineStyle = xlNone
Selection.ClearFormats
Cells.FormatConditions.Delete
Columns("B:B").Select
Selection.Insert Shift:=xlToLeft
Range("A10").Select
Range("A10:P10").Value = [{"AO","Status/Kommentar","Order","Kund","Ansvarig tekniker","Fakturerat","SVA","Oms?ttning","Material kostnad","Arbets kostnad","?vriga kostnader","Summa kostnader","TBO","Timmar","TB0 kr/timme","TG%"}]
Range(Selection, Selection.End(xlToRight)).Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("N:N").Cut
Columns("I:I").Insert
Columns("P:P").Cut
Columns("J:J").Insert
Cells.EntireColumn.AutoFit
Columns("B:B").ColumnWidth = 25
Columns("C:C").ColumnWidth = 55
Columns("D:D").ColumnWidth = 25
Columns("F:P").Select
Selection.NumberFormat = "#,##0 $"
Columns("J").Select
Selection.NumberFormat = "0%"
Columns("I:I").Select
Selection.NumberFormat = "#,##0.00"
Range("G11").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="=0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16752384
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("A10").Select
'Sort, SVA
With PR11_P3_Tabell.Sort
.SortFields.Clear
.SortFields.Add Key:=PR11_P3_Tabell.ListColumns("SVA").Range, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Public Function wsPR11_P3() As Worksheet
Set wsPR11_P3 = ThisWorkbook.Worksheets("PR11_P3")
End Function
Public Property Get PR11_P3_Tabell() As ListObject
Set PR11_P3_Tabell = wsPR11_P3.ListObjects("PR11_P3_Tabell")
End Property
uj5u.com熱心網友回復：
使用打開檔案夾中的最新檔案FileDateTime
Sub ImportData()
Const sFolderPath As String = "C:\Test\rapport\"
' Open the newest file.
Dim sFileName As String: sFileName = Dir(sFolderPath & "_pr11*.xlsx")
If Len(sFileName) = 0 Then Exit Sub ' no file found
Dim cuDate As Date, sFileDate As Date, cuPath As String, sFilePath As String
Do Until Len(sFileName) = 0
cuPath = sFolderPath & sFileName
cuDate = FileDateTime(cuPath)
Debug.Print "Current: " & cuDate & " " & cuPath ' print current
If cuDate > sFileDate Then
sFileDate = cuDate
sFilePath = cuPath
End If
sFileName = Dir
Loop
Debug.Print "Result: " & sFileDate & " " & sFilePath ' print result
' See in the VBE Immediate window 'CTRL G' what was checked
' and what was determined to open.
' When done testing, out-comment or delete the two 'Debug.Print' lines.
Dim closedBook As Workbook: Set closedBook = Workbooks.Open(sFilePath)
' Continue
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/456958.html
下一篇：已經創建行后如何添加到行