[英]Excel-VBA sheet split and save ends up with many blank columns delimited by commas
I am new to excel-vba and been able to successfully copy certain columns into new sheets and save the new sheets as separate csv files however, when I open the newly created files in notepad, i can see a ton of extra commas representing a lot of extra unnecessary columns. 我是excel-vba的新手,能够成功将某些列复制到新工作表中并将新工作表另存为单独的csv文件,但是,当我在记事本中打开新创建的文件时,我可以看到大量的逗号,它们代表了很多多余的列。 I added another step to delete columns in the newly created sheet prior to save however, that still did not address the issue. 我添加了另一个步骤,以便在保存之前删除新创建的工作表中的列,但是仍然无法解决该问题。
To reiterate, I am having a user complete data on one sheet, I then after they click a button, split the sheet into two new sheets, I then save each new sheet as its own CSV workbook. 重申一下,我让用户在一张纸上完成数据,然后在他们单击按钮后,将纸分成两张新纸,然后将每张新纸另存为自己的CSV工作簿。 These are then used externally. 这些然后在外部使用。 The newly created CSV files has excessive comma delimited columns that with my delete column sub, are still present. 新创建的CSV文件包含过多的以逗号分隔的列,这些列与我的delete column子一起仍然存在。
thanks! 谢谢! Chris 克里斯
Here is my code: 这是我的代码:
Sub Prepare()
ReplaceWithValues
SplitSheet
ConvertDateFormat
ExportToCSV
DeleteSplitSheets
DisplaySuccess
End Sub
Sub ReplaceWithValues()
' Removes all formulas from Data sheet and pastes only values
Sheets("Data").Select
Range("A3").Select
Range("A3").CurrentRegion.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
End Sub
Sub SplitSheet()
' Check to see if Contact sheet exists, if not create it
For i = 1 To Worksheets.Count
If Worksheets(i).Name = "Contacts" Then
exists = True
End If
Next i
If Not exists Then
Worksheets.Add.Name = "Contacts"
End If
' Splits out Contact data into new sheet for contact export
Sheets("Data").Columns("A:V").Copy Sheets("Contacts").Range("A1")
' Check to see if Interactions sheet exists, if not create it
For i = 1 To Worksheets.Count
If Worksheets(i).Name = "Interactions" Then
exists = True
End If
Next i
If Not exists Then
Worksheets.Add.Name = "Interactions"
End If
' First copy over ID origin and ID to Interactions Sheet
Sheets("Data").Columns("A:B").Copy Sheets("Interactions").Range("A1")
' Splits out Interaction Data into new Sheet for Interaction export
Sheets("Data").Columns("W:AJ").Copy Sheets("Interactions").Range("C1")
End Sub
Sub ConvertDateFormat()
Sheets("Interactions").Range("E3", "E50000").NumberFormat = "yyyymmddhhmmss"
End Sub
Sub ExportToCSV()
Dim dt As String
' Save Contacts File
For i = 1 To Worksheets.Count
If Worksheets(i).Name = "Contacts" Then
exists = True
End If
Next i
If exists Then
DeleteEmptyColumns "Contacts"
'Sheets("Contacts").Select
'dt = Format(CStr(Now))
dt = Format(Now(), "yyyymmddhhmmss")
'filepart1 = "Bulk_Contacts_"
fileSaveAsName = "Bulk_Contacts_" + dt
'fileSaveAsName = Application.GetSaveAsFilename(fileSaveAsName)
fileSaveAsName = Application.GetSaveAsFilename(InitialFileName:=fileSaveAsName, FileFilter:="csv Files (*.csv), *.csv")
If fileSaveAsName = False Then
Exit Sub
End If
'fileSaveAsName = fileSaveAsName + ".csv"
' ActiveWorkbook.SaveAs Filename:=fileSaveAsName, FileFormat:=xlUnicodeText, CreateBackup:=False
' ActiveWorkbook.Worksheets.s Filename:=fileSaveAsName, FileFormat:=xlUnicodeText, CreateBackup:=False
Application.DisplayAlerts = False
ThisWorkbook.Sheets("Contacts").Copy
On Error GoTo unSuccessful
ActiveWorkbook.SaveAs Filename:=fileSaveAsName, FileFormat:=xlCSV, CreateBackup:=True
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True
End If
' Save Interactions File
For i = 1 To Worksheets.Count
If Worksheets(i).Name = "Interactions" Then
exists = True
End If
Next i
If exists Then
Sheets("Interactions").Select
fileSaveAsName = "Bulk_Interactions_" & dt
fileSaveAsName = Application.GetSaveAsFilename(InitialFileName:=fileSaveAsName, FileFilter:="csv Files (*.csv), *.csv")
If fileSaveAsName = False Then
Exit Sub
End If
'fileSaveAsName = fileSaveAsName + ".csv"
' ActiveWorkbook.SaveAs Filename:=fileSaveAsName, FileFormat:=xlUnicodeText, CreateBackup:=False
Application.DisplayAlerts = False
ThisWorkbook.Sheets("Interactions").Copy
On Error GoTo unSuccessful
ActiveWorkbook.SaveAs Filename:=fileSaveAsName, FileFormat:=xlCSV, CreateBackup:=True
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True
End If
'MsgBox "Files Successfully Prepared and Exported!"
Exit Sub
unSuccessful:
MsgBox Err.Description
Exit Sub
End Sub
Sub DeleteSplitSheets()
' Check if Interactions sheet exists and delete if present.
For i = 1 To Worksheets.Count
If Worksheets(i).Name = "Interactions" Then
exists = True
End If
Next i
If exists Then
Application.DisplayAlerts = False
Sheets("Interactions").Delete
Application.DisplayAlerts = True
End If
' Check if Contacts sheet exists and delete if present.
For i = 1 To Worksheets.Count
If Worksheets(i).Name = "Contacts" Then
exists = True
End If
Next i
If exists Then
Application.DisplayAlerts = False
Sheets("Contacts").Delete
Application.DisplayAlerts = True
End If
End Sub
Sub DisplaySuccess()
MsgBox "Files Successfully Prepared and Exported!"
End Sub
Sub DeleteEmptyColumns(SheetName As String)
Dim ws As Worksheet
Dim rng As Range
Dim lastRow As Long
Dim lastCol As Long
Set ws = ThisWorkbook.Sheets(SheetName)
lastCol = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
lastCol = lastCol + 1
' myCol = GetColumnLetter(lastCol)
Dim vArr
vArr = Split(Cells(1, lastCol).Address(True, False), "$")
myCol = vArr(0)
ws.Columns(myCol & ":XFD").Delete Shift:=xlToLeft
End Sub
All, Thanks for your replies. 全部,谢谢您的答复。 I found the issue. 我发现了问题。 I was performing a column format and rather than taking only rows that were populated, I was formatting all rows. 我正在执行列格式,而不是仅对已填充的行进行格式化,而是对所有行进行了格式化。 This was causing the excess blank delimited columns. 这导致多余的空白定界列。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.