使用 VBA 從 Excel 導出 CSV 並導入到 Visual Planning 中

Question

我對 VBA 完全陌生，在這里有點迷失。 我有一個包含同事假期的 Excel 文件。 一年中的每一天都有一個單元格，他們需要在其中輸入“X”。 我需要用 VBA 編寫一個宏來導出一個 CSV 文件，該文件導出他們的人員編號以及他們假期的開始和結束日期。 我還需要一個邏輯來跳過周末。 我需要將 CSV 文件導入到 Visual Planning 中。 它應該是一個表格，以人員編號、開始日期和結束日期為列我該怎么做？ 你能幫我嗎？

Sub Makro1()

'

Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
Set ws = Worksheets("2021")

Dim ersteZeile As Integer
Dim letzteZeile As Integer

Dim c As Range
Dim datumRow As Integer
Dim d As Range

datumRow = 4


ersteZeile = 5
letzteZeile = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row

anfangsRange = "I" & ersteZeile
endrange = "NI" & letzteZeile

For Each c In ws.Range("I5:NI71")
    If Not c.Value = "" Then
        Cells(4, c.Column).Copy Destination:=Sheets("CSV").Column("BEGDA")
    End If
Next c

結束子

這是我到目前為止得到的代碼，但我需要將“X”動態復制到我的 CSV 表中。

Answer 1

請嘗試下一個代碼。 它構建一個遵守 CSV 創建規則的字符串，並將其放在最后的文件中。 文件名將是importEmployee.csv ，它將在保留此代碼路徑的工作簿中找到。 您可以根據需要更改路徑（在最后的代碼部分）：

Sub ExportCSVHolidayDays()
 Dim sh As Worksheet, lastRow As Long, lastCol As Long, arrPn, arrH, arrInt
 Dim i As Long, j As Long, strCSV As String, startD As String, endD As String
 Dim lngSt As Long, lngEnd As Long, arrI
 
 Set sh = ActiveSheet
 lastRow = sh.Range("A" & rows.count).End(xlUp).row
 lastCol = sh.cells(4, Columns.count).End(xlToLeft).Column
 
 arrPn = sh.Range("A5:A" & lastRow).Value
 arrH = sh.Range("H4", sh.cells(lastRow, lastCol)).Value
 
 For i = 1 To UBound(arrPn)
    arrInt = Application.Index(arrH, i + 1, 0)       'extract a row slice of arrH
    arrI = Split(StrReverse(Join(arrInt, ",")), ",") 'reverse the slice array
    
     lngSt = WorksheetFunction.Match("X", arrInt, 0) 'first "X" position
    startD = arrH(1, lngSt): ' start date (from arrH first row)
     lngEnd = UBound(arrI) - WorksheetFunction.Match("X", arrI, 0) + 2 'last "X" pos
    endD = arrH(1, lngEnd):  ' end date (from arrH first row)
    
    If strCSV = "" Then
        'write the first row of the CSV string - first employee
        strCSV = arrPn(i, 1) & "," & startD & "," & endD & vbCrLf
    Else
        'next employee first line
        strCSV = strCSV & arrPn(i, 1) & "," & startD & "," & endD & vbCrLf
    End If
        startD = "": endD = ""                            'reinitialize the variables
        For j = lngSt To lngEnd + 1
            If UCase(arrInt(j)) = "X" And startD = "" Then startD = arrH(1, j)          'new start date
            If arrInt(j) = "" And endD = "" And startD <> "" Then endD = arrH(1, j - 1) 'new end date
            
            If endD <> "" Then
                'write the sequence inside the total start and end date
                strCSV = strCSV & arrPn(i, 1) & "," & startD & "," & endD & vbCrLf
            End If
            If arrInt(j) = "" Then startD = "": endD = "" 'reinitialize the variables
        Next
 Next
 'write the CSV file from string (strCSV):
 Dim expPath As String
 expPath = ThisWorkbook.Path & "\importEmployee.csv"
 Open expPath For Output As #1
    Print #1, strCSV
 Close #1
 MsgBox "Ready..." & vbCrLf & _
        "Here you can find he CSV exported file: " & expPath & ".", _
                            vbInformation, "Finishing confirmation"
End Sub

請在測試后發送一些反饋。