使用 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

请在测试后发送一些反馈。