在这里，我有一个巨大的Excel工作簿，用户可以用它来编写报价。在保存时，我将相关数据传输到文本文件并保存该文本文件，而不是保存庞大的工作簿。除了包含格式的一个工作表之外，它没有任何障碍。我不希望用户在加载以前保存的引号（从文本文件）时丢失格式，因此我需要确定一种将格式数据传输到文本文件和从文本文件传输的方法。有没有一种聪明的方法可以在不编写数百行代码或使用任何非原生Excel功能的情况下执行此操作？
以下是其他工作表的代码示例，但对我正在尝试的内容没有多大帮助：
Sub WriteQuote()
Dim SourceFile As String
Dim data As String
Dim ToFile As Integer
Dim sh1, sh2, sh3 As Worksheet
Set sh1 = Sheets("sheet 1")
Set sh2 = Sheets("sheet 2")
Set sh3 = Sheets("sheet 3")
SourceFile = "C:\Users\███████\Desktop\test.txt"
ToFile = FreeFile
Open SourceFile For Output As #ToFile
'PRINT DETAILS TO TXT FILE
For i = 7 To 56
If sh1.Range("B" & i).Value <> "" Then
data = sh1.Range("B" & i).Value & "__"
If sh1.Range("D" & i).Value <> "" Then
data = data & sh1.Range("D" & i).Value & "__"
Else: data = data & " __"
End If
If sh1.Range("E" & i).Value <> "" Then
data = data & "ns" & "__"
Else: data = data & " __"
End If
data = data & sh1.Range("F" & i).Value & "__"
data = data & sh1.Range("G" & i).Value & "__"
data = data & sh1.Range("J" & i).Value & "__"
data = data & sh1.Range("M" & i).Value
Else: Exit For
End If
Print #ToFile, data
Next i
Close #ToFile
End Sub
答案 0 :(得分：1)
这是使用用户类型（“记录”）和随机访问IO的示例。 有限制，我相信使用随机访问 可能会浪费磁盘上的空间，但这是合理的 这样做的方法。
在示例中，我建议对布尔属性使用位掩码， 例如“Bold”（位掩码可以节省空间并缩短代码）。
文件读/写操作基于： https://support.microsoft.com/en-us/kb/150700
!!!但是，您可能会遇到“错误记录长度”错误 每一件都很好，第一次工作。有关于此问题的报告（谷歌VBA坏记录长度）。如果是这种情况，您可能希望将IO更改为二进制而不是随机（将需要更改代码）。
<强> !!!!!添加模块并将代码粘贴到那里，或者至少， 将记录粘贴到模块中（而不是在工作表中）。
Option Explicit
' Setting up a user type ("record").
' you can add more variables, however just makes sure they are fixed
' length, for example: integer\doube\byte\... Note that if you want to
' add a string, ' make sure to give it fixed length, as shown below.
Public Type OneCellRec
' this will hold the row of the source cell
lRow As Long
' this will hold the column of the source cell
lColumn As Long
' This will hold the value of the cell.
' 12 is the maximum length you expect a cell to have-
' CHANGE it as you see fit
Value As String * 12
' This hold the number format- again, you might need to
' twik the 21 length-
NumberFormat As String * 21
' will hold design values like Bold, Italic and so on
DesignBitMask1 As Integer
' will hold whether the cells has an underline- this is not boolean,
' as there are several type of underlines available.
UnderLine As Long
FontSize As Double
End Type
' ---- RUN THIS ---
Public Sub TestFullTransferUsingRec()
Dim cellSetUp As Range
Dim cellSrc As Range
Dim cellDst As Range
Dim r As OneCellRec
Dim r2 As OneCellRec
On Error Resume Next
Kill "c:\file1.txt"
On Error GoTo 0
On Error GoTo errHandle
' For the example,
' Entering a value with some design values into a cell in the sheet.
' --------------------------------------
Set cellSetUp = ActiveSheet.Range("A1")
cellSetUp.Value = 1.5
cellSetUp.Font.Bold = True
cellSetUp.Font.Size = 15
cellSetUp.Font.UnderLine = xlUnderlineStyleSingle
cellSetUp.NumberFormat = "$#,##0.00"
' Doing it again for example purposes, in a different cell.
Set cellSetUp = ActiveSheet.Range("C5")
cellSetUp.Value = "banana"
cellSetUp.Font.Bold = True
cellSetUp.Font.Size = 15
cellSetUp.Font.UnderLine = XlUnderlineStyle.xlUnderlineStyleDouble
' ============ saving the cells to the text file =============
' open file for write
Open "c:\file1.txt" For Random As #1 Len = Len(r)
' save to a record the value and the design of the cell
Set cellSrc = ActiveSheet.Range("A1")
r = MyEncode(cellSrc)
Put #1, , r
' save to a record the value and the design of the cell
Set cellSrc = ActiveSheet.Range("C5")
r = MyEncode(cellSrc)
Put #1, , r
Close #1
' ============ loading the cells from the text file =============
Application.EnableEvents = False
' open file for read
Dim i%
Open "c:\file1.txt" For Random As #1 Len = Len(r2)
' read the file
For i = 1 To Int(LOF(1) / Len(r))
Get #1, i, r2
' destination cell- write the value and design
' --------------------------------------------
Set cellDst = Sheet2.Cells(r2.lRow, r2.lColumn)
Call MyDecode(cellDst, r2)
Next
'Close the file.
Close #1
errHandle:
If Err.Number <> 0 Then
MsgBox "Error: " & Err.Number & " " & _
Err.Description, vbExclamation, "Error"
On Error Resume Next
Close #1
On Error GoTo 0
End If
Application.EnableEvents = True
End Sub
' Gets a single cell- extracts the info you want into a record.
Public Function MyEncode(cell As Range) As OneCellRec
Dim r As OneCellRec
Dim i%
i = 0
r.lRow = cell.row
r.lColumn = cell.column
r.Value = cell.Value
r.FontSize = cell.Font.Size
r.UnderLine = cell.Font.UnderLine
r.NumberFormat = cell.NumberFormat
' Use a bit mask to encode true\false excel properties.
' the encode is done using "Or"
If cell.Font.Bold = True Then i = i Or 1
If cell.Font.Italic = True Then i = i Or 2
'If cell. ..... .. = True Then i = i Or 4
'If cell. ..... .. = True Then i = i Or 8
'If cell. ..... .. = True Then i = i Or 16
'If cell. ..... .. = True Then i = i Or 32
'If cell. ..... .. = True Then i = i Or 64
'If cell. ..... .. = True Then i = i Or 128
'If cell. ..... .. = True Then i = i Or 256
' Remember the Integer limit. If you want more than int can handle,
' use long type for the i variable and r.DesignBitMask1 variable.
'If cell. ..... .. = True Then i = i Or ' (2^x)-
r.DesignBitMask1 = i
MyEncode = r
End Function
' Decode- write the info from a rec to a destination cell
Public Sub MyDecode(cell As Range, _
r As OneCellRec)
Dim i%
cell.Value = r.Value
i = r.DesignBitMask1
cell.Value = Trim(r.Value)
cell.Font.Size = r.FontSize
cell.Font.UnderLine = r.UnderLine
' trim is important here
cell.NumberFormat = Trim(r.NumberFormat)
' Use a bit mask to decode true\false excel properties.
' the decode is done using "And"
If i And 1 Then cell.Font.Bold = True
If i And 2 Then cell.Font.Italic = True
'If i And 4 Then ...
'If i And 8 Then ...
'...
End Sub
答案 1 :(得分：0)
您可以尝试TextToColumns。您正在＆＃34; __＆＃34;中编写分隔符。你可以利用。它似乎在接收解析的文本时保持单元格的格式化。
Sub ReadQuote()
SourceFile = "C:\Users\||||||\Desktop\test.txt"
Open SourceFile For Input As #8
Input #8, data
Range("M1") = data 'Temporary holder for an input line
'Range to start the parsed data "A1" in this example
Range("A1") = Range("M1").TextToColumns(, xlDelimited, , , , , , , , "__")
Close #8
End Sub