gpt4 book ai didi

vba - 用双引号引用单元格值 : Excel VBA Macro

转载 作者:行者123 更新时间:2023-12-02 07:48:25 25 4
gpt4 key购买 nike


我想在特定列的所有单元格内添加双引号。我已经编写了添加双引号的代码,但问题是它在值周围添加了 3 个双引号。

 For Each myCell In ActiveWorkbook.Sheets("Sheet1").Range("B:B")
If myCell.Value <> "" Then
myCell.Value = Chr(34) & myCell.Value & Chr(34)
End If
Next myCell

基本要求是按照B列拆分excel文件,并保存为CSV文件。
在拆分字段中,B 列和 D 列的值必须用双引号引起来。

完整代码:

Option Explicit

Sub ParseItems()
Dim LR As Long, Itm As Long, MyCount As Long, vCol As Long
Dim ws As Worksheet, MyArr As Variant, vTitles As String, SvPath As String
Dim myCell As Range, transCell As Range

'Sheet with data in it
Set ws = Sheets("Sheet1")

'Path to save files into, remember the final \
SvPath = "D:\SplitExcel\"

'Range where titles are across top of data, as string, data MUST
'have titles in this row, edit to suit your titles locale
'Inserting new row to act as title, copying the data from first row in title, row deleted after use
ws.Range("A1").EntireRow.Insert
ws.Rows(2).EntireRow.Copy
ws.Range("A1").Select
ws.Paste
vTitles = "A1:Z1"

'Choose column to evaluate from, column A = 1, B = 2, etc.
vCol = 2
If vCol = 0 Then Exit Sub

'Spot bottom row of data
LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row

'Speed up macro execution
Application.ScreenUpdating = False

'Get a temporary list of unique values from key column
ws.Columns(vCol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("EE1"), Unique:=True

'Sort the temporary list
ws.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

'Put list into an array for looping (values cannot be the result of formulas, must be constants)
MyArr = Application.WorksheetFunction.Transpose(ws.Range("EE2:EE" & Rows.Count).SpecialCells(xlCellTypeConstants))

'clear temporary worksheet list
ws.Range("EE:EE").Clear

'Turn on the autofilter, one column only is all that is needed
'ws.Range(vTitles).AutoFilter

'Loop through list one value at a time
For Itm = 1 To UBound(MyArr)
ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm)
'transCell = ws.Range("A2:A" & LR)
ws.Range("A2:A" & LR).EntireRow.Copy
Workbooks.Add
Range("A1").PasteSpecial xlPasteAll
Cells.Columns.AutoFit
MyCount = MyCount + Range("A" & Rows.Count).End(xlUp).Row - 1



For Each myCell In ActiveWorkbook.Sheets("Sheet1").Range("B:B")
If myCell.Value <> "" Then
myCell.Value = Chr(34) & myCell.Value & Chr(34)
End If
Next myCell



ActiveWorkbook.SaveAs SvPath & "po" & MyArr(Itm) & ActiveWorkbook.Sheets("Sheet1").Range("D1") & "." & Date2Julian(Date), xlCSV, local:=False
ActiveWorkbook.Close False

ws.Range(vTitles).AutoFilter Field:=vCol
Next Itm

'Cleanup
ws.Rows(1).EntireRow.Delete
ws.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

Function Date2Julian(ByVal vDate As Date) As String

Date2Julian = Format(DateDiff("d", CDate("01/01/" _
+ Format(Year(vDate), "0000")), vDate) _
+ 1, "000")



End Function

示例输入数据:

24833837    8013    70  1105
25057089 8013 75 1105
25438741 8013 60 1105
24833837 8014 70 1106
25057089 8014 75 1106
25438741 8014 60 1106

预期输出是使用以下数据创建的两个文件


文件 1:

24833837,"8013",70,1105
25057089,"8013",75,1105
25438741,"8013",60,1105

文件 2:

24833837,"8014",70,1106
25057089,"8014",75,1106
25438741,"8014",60,1106

结果输出:

文件 1:

24833837,"""8013""",70,1105
25057089,"""8013""",75,1105
25438741,"""8013""",60,1105

文件 2 相同

请帮忙。 :)

最佳答案

据我所知,在使用正常的“另存为 csv”过程时,没有简单的方法可以欺骗 Excel 在数字周围使用引号。不过,您可以使用 VBA 以您喜欢的任何 csv 格式保存。

https://support.microsoft.com/en-us/help/291296/procedure-to-export-a-text-file-with-both-comma-and-quote-delimiters-in-excel 中的代码示例

只需添加一个if语句来确定是否使用引号

' Write current cell's text to file with quotation marks.
If WorksheetFunction.IsText(Selection.Cells(RowCount, ColumnCount)) Then
Print #FileNum, """" & Selection.Cells(RowCount, _
ColumnCount).Text & """";
Else
Print #FileNum, Selection.Cells(RowCount, _
ColumnCount).Text;
End If

如果您输入的数字前面带有 '(单高引号),WorksheetFunction.IsText 会将您的数字识别为文本

您需要调整示例,以从代码中使用预先给定的文件名导出所需的范围。

关于vba - 用双引号引用单元格值 : Excel VBA Macro,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/43042674/

25 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com