我可以使用 VBA 复制单元格格式,即将值视为字符串而不是数字吗?

发布于 2024-10-22 06:48:47 字数 4283 浏览 0 评论 0原文

我正在使用 VBA 删除导入的标头。

我现在遇到的问题是该过程正在截断日期中的前导 0。即使是像向我指出 Cells(#, #) 对象可用的所有方法的描述这样简单的事情也会有所帮助。


 ' VBScript source code
Option Explicit
REM We use "Option Explicit" to help us check for coding mistakes

REM the Excel Application
Dim objExcel
REM the path to the excel file
Dim excelPath
REM how many worksheets are in the current excel file
Dim worksheetCount
Dim counter
REM the worksheet we are currently getting data from
Dim currentWorkSheet
REM the number of columns in the current worksheet that have data in them
Dim usedColumnsCount
REM the number of rows in the current worksheet that have data in them
Dim usedRowsCount
Dim row
Dim column
REM the topmost row in the current worksheet that has data in it
Dim top
REM the leftmost row in the current worksheet that has data in it
Dim left
Dim Cells
REM the current row and column of the current worksheet we are reading
Dim curCol
Dim curRow
REM the value of the current row and column of the current worksheet we are reading
Dim word

REM the text file writer that I will output to to see what this process is creating
Dim objFSOExcel
REM the output worksheet
Dim outputWorksheet
Dim objWorkbook

REM where is the Excel file located?
excelPath = "C:\Documents and Settings\kitchenjt\My Documents\Professional Development\input\11TRVL.xls"

REM Create an invisible version of Excel
Set objExcel = CreateObject("Excel.Application")

REM create the Output Excel file
Set objFSOExcel = CreateObject("Excel.Application")
Set objWorkBook = ObjFSOExcel.Workbooks.Add
Set outputWorksheet = objWorkBook.Worksheets(1)
'outputWorksheet.Name = "SafeTRVL"

REM don't display any messages about documents needing to be converted
REM from  old Excel file formats
objExcel.DisplayAlerts = 0
objFSOExcel.DisplayAlerts = 0


REM open the excel document as read-only
REM open (path, confirmconversions, readonly)
objExcel.Workbooks.open excelPath, false, true


REM How many worksheets are in this Excel documents
REM changed to only get the first worksheet
workSheetCount = 1'objExcel.Worksheets.Count

Dim outrow
outrow = 1

REM Loop through each worksheet
For counter = 1 to workSheetCount
    'txtFile.writeLine("-----------------------------------------------")
    'txtFile.writeLine("Reading data from worksheet " & counter & vbCRLF)

    Set currentWorkSheet = objExcel.ActiveWorkbook.Worksheets(counter)
    REM how many columns are used in the current worksheet
    usedColumnsCount = currentWorkSheet.UsedRange.Columns.Count
    REM how many rows are used in the current worksheet
    usedRowsCount = currentWorkSheet.UsedRange.Rows.Count

    REM What is the topmost row in the spreadsheet that has data in it
    top = currentWorksheet.UsedRange.Row
    REM What is the leftmost column in the spreadsheet that has data in it
    left = currentWorksheet.UsedRange.Column


    Set Cells = currentWorksheet.Cells
    REM Loop through each row in the worksheet 
    For row = 0 to (usedRowsCount-1)

        REM Loop through each column that has an intial value that starts with T in the worksheet 
        REM only look at rows that are in the "used" range
        curRow = row+top
        word = Cells(curRow,left).Value
        REM display the column on the screen
        if word <> "" and InStr(1,word,"T",1) > 0 and Cells(curRow, left+1).value <> "" then
            For column = 0 to usedColumnsCount-1
                REM only look at columns that are in the "used" range
                curCol = column+left
                REM get the value/word that is in the cell 
                word = Cells(curRow,curCol).Value
                REM add the column to the new excel file
                outputWorksheet.Cells(outrow, curCol).Value = word' = Cells(curRow,curCol)
            Next
            outrow = outrow + 1
        end if
    Next

    REM We are done with the current worksheet, release the memory
    Set currentWorkSheet = Nothing
Next

objWorkbook.SaveAs("C:\Documents and Settings\kitchenjt\My Documents\Professional Development\input\CleanExcel.xls")
objWorkbook.Close
objFSOExcel.Quit
objExcel.Workbooks(1).Close
objExcel.Quit

Set currentWorkSheet = Nothing
REM We are done with the Excel object, release it from memory
Set objExcel = Nothing

I am using VBA to strip out the headers for an import.

The issue I am having now is that the process is truncating leading 0's from dates. Even something as simple as pointing me to a description of all the methods available for the Cells(#, #) object would help.


 ' VBScript source code
Option Explicit
REM We use "Option Explicit" to help us check for coding mistakes

REM the Excel Application
Dim objExcel
REM the path to the excel file
Dim excelPath
REM how many worksheets are in the current excel file
Dim worksheetCount
Dim counter
REM the worksheet we are currently getting data from
Dim currentWorkSheet
REM the number of columns in the current worksheet that have data in them
Dim usedColumnsCount
REM the number of rows in the current worksheet that have data in them
Dim usedRowsCount
Dim row
Dim column
REM the topmost row in the current worksheet that has data in it
Dim top
REM the leftmost row in the current worksheet that has data in it
Dim left
Dim Cells
REM the current row and column of the current worksheet we are reading
Dim curCol
Dim curRow
REM the value of the current row and column of the current worksheet we are reading
Dim word

REM the text file writer that I will output to to see what this process is creating
Dim objFSOExcel
REM the output worksheet
Dim outputWorksheet
Dim objWorkbook

REM where is the Excel file located?
excelPath = "C:\Documents and Settings\kitchenjt\My Documents\Professional Development\input\11TRVL.xls"

REM Create an invisible version of Excel
Set objExcel = CreateObject("Excel.Application")

REM create the Output Excel file
Set objFSOExcel = CreateObject("Excel.Application")
Set objWorkBook = ObjFSOExcel.Workbooks.Add
Set outputWorksheet = objWorkBook.Worksheets(1)
'outputWorksheet.Name = "SafeTRVL"

REM don't display any messages about documents needing to be converted
REM from  old Excel file formats
objExcel.DisplayAlerts = 0
objFSOExcel.DisplayAlerts = 0


REM open the excel document as read-only
REM open (path, confirmconversions, readonly)
objExcel.Workbooks.open excelPath, false, true


REM How many worksheets are in this Excel documents
REM changed to only get the first worksheet
workSheetCount = 1'objExcel.Worksheets.Count

Dim outrow
outrow = 1

REM Loop through each worksheet
For counter = 1 to workSheetCount
    'txtFile.writeLine("-----------------------------------------------")
    'txtFile.writeLine("Reading data from worksheet " & counter & vbCRLF)

    Set currentWorkSheet = objExcel.ActiveWorkbook.Worksheets(counter)
    REM how many columns are used in the current worksheet
    usedColumnsCount = currentWorkSheet.UsedRange.Columns.Count
    REM how many rows are used in the current worksheet
    usedRowsCount = currentWorkSheet.UsedRange.Rows.Count

    REM What is the topmost row in the spreadsheet that has data in it
    top = currentWorksheet.UsedRange.Row
    REM What is the leftmost column in the spreadsheet that has data in it
    left = currentWorksheet.UsedRange.Column


    Set Cells = currentWorksheet.Cells
    REM Loop through each row in the worksheet 
    For row = 0 to (usedRowsCount-1)

        REM Loop through each column that has an intial value that starts with T in the worksheet 
        REM only look at rows that are in the "used" range
        curRow = row+top
        word = Cells(curRow,left).Value
        REM display the column on the screen
        if word <> "" and InStr(1,word,"T",1) > 0 and Cells(curRow, left+1).value <> "" then
            For column = 0 to usedColumnsCount-1
                REM only look at columns that are in the "used" range
                curCol = column+left
                REM get the value/word that is in the cell 
                word = Cells(curRow,curCol).Value
                REM add the column to the new excel file
                outputWorksheet.Cells(outrow, curCol).Value = word' = Cells(curRow,curCol)
            Next
            outrow = outrow + 1
        end if
    Next

    REM We are done with the current worksheet, release the memory
    Set currentWorkSheet = Nothing
Next

objWorkbook.SaveAs("C:\Documents and Settings\kitchenjt\My Documents\Professional Development\input\CleanExcel.xls")
objWorkbook.Close
objFSOExcel.Quit
objExcel.Workbooks(1).Close
objExcel.Quit

Set currentWorkSheet = Nothing
REM We are done with the Excel object, release it from memory
Set objExcel = Nothing

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(1

思念绕指尖 2024-10-29 06:48:47

在写入之前将输出单元格的 NumberFormat 设置为文本:

Cells(curRow, curCol).NumberFormat = "@"
REM get the value/word that is in the cell 
word = Cells(curRow,curCol).Value

Set the output cell's NumberFormat to text before writing to it:

Cells(curRow, curCol).NumberFormat = "@"
REM get the value/word that is in the cell 
word = Cells(curRow,curCol).Value
~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文