有没有适当的方式来执行这个任务，而不诉诸自定义的子程序？
问题总结
我在VBA中编写了一个excelmacros，导入一个大文本文件，读取每一行以确定要存储的数据的数量，为数组分配正确的大小以容纳数据，然后再次打开文件以写入数据进入arrays。
我遇到的这个程序的问题是大的文本文件有不一致的标签尺寸行。 我不得不写一个特殊的分隔符filter函数来select正确的数据存储到数组中。
有没有适当的方式来执行这个任务，而不诉诸自定义的子程序？
程序规格
程序必须执行数据分析，以便与下面的模型最佳拟合：其中包括负指数。 程序不允许退出后将数据保留在Excel电子表格中，但这并不意味着它不能暂时放置。 性能和速度对于不耐烦的用户来说是重要的。 导入的数据可以具有未指定数量的重复列types和未定义的制表符长度分隔。
打开build议
我很乐意利用预定义的excel函数并将数据存储在excelvariables中。
从文本文件中确定数据的大小
Dim LineText As String ' indiviudal line of row text from data file Dim runs As Long ' number of delimited column of data we're interested in Dim count As Long ' number rows in data file Dim data() As Double 'data from text file Dim i As Long ' array index iF1 = FreeFile ' Returns an Integer representing the next file number available for use by the Open statement. Open MyFile For Input As #iF1 'open data file first time Line Input #iF1, LineText ' skip first line Line Input #iF1, LineText ' read second line runs = Len(LineText) - Len(Replace(LineText, "T", "")) ' number of occurences of character T count = 0 While Not EOF(iF1) 'EOF means 'end of file' Line Input #iF1, LineText count = count + 1 Wend ' end of while loop Close #iF1 'close text file ReDim data(count, 2) 'resize 'data' array to number of rows in text file
重新打开文本文件并将所有数据存储到数组中
Open MyFile For Input As #iF1 ' reopen data file second time Line Input #iF1, LineText ' skip first line Line Input #iF1, LineText ' skip second line i = 1 'set index to first element in array While Not EOF(iF1) 'EOF means 'end of file' Line Input #iF1, LineText 'read line from text data(i, 1) = Val(delimit_extract(LineText, 4 * runs - 0)) ' frequnecy data data(i, 2) = Val(delimit_extract(LineText, 4 * runs - 2)) ' voltage data i = i + 1 'update array index Wend ' end of while loop Close #iF1 'close text file
delimit_extract函数
Private Function delimit_extract(text As String, x As Long) As String ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''function finds xth number in string text regardless of tab size ''x is the xth number desired in text ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim c As String ' holds indiviudal characters from text Dim i_start As Long 'stores first index of recently discovered number Dim i_end As Long 'stores last index of recently discovered number Dim x_count As Long 'tallies current count of numbers discovered in text Dim flag As Boolean ' flags true if first index of new number false otherwise i_start = 1 i_end = 1 x_count = 0 flag = True 'set flag true for possible discovery of new number For i = 1 To Len(text) ' loop through all characters in text c = Mid(text, i, 1) 'extract individual character from text If (c = ".") Or (c = "-") Or (c = "E") Or ((Asc(0) <= Asc(c)) And (Asc(c) <= Asc(9))) Then 'if character is related to a number If flag = True Then 'catch new number discovered x_count = x_count + 1 '' update total number of numbers discovered i_start = i ' mark location of number in string flag = False ' set recently discovered number to false End If i_end = i 'mark last known index of recently discovered number Else flag = True 'set flag true for possible discovery of new number If (x_count = x) Then 'if total discovered numbers equals desired number Exit For End If End If Next i delimit_extract = Mid(text, i_start, i_end - i_start + 1) End Function
数据文本文件的样本
Run #1 Run #1 Run #1 Run #1 Run #1 Run #2 Run #2 Run #2 Run #2 Run #2 Time (s) Voltage (V) Output Frequency (Hz) Calc3 (units) w Time (s) Voltage (V) Output Frequency (Hz) Calc3 (units) w 0.000 -0.060 69.940 0.00 0.00 0.000 0.034 29.980 0.00 0.00 5.000E-5 -0.024 1.26E-6 0.05 5.000E-5 0.078 1.26E-6 0.05 1.000E-4 0.059 2.51E-6 0.10 1.000E-4 -0.045 2.51E-6 0.10 1.500E-4 0.008 3.77E-6 0.15 1.500E-4 -0.056 3.77E-6 0.15 2.000E-4 -0.051 5.03E-6 0.20 2.000E-4 0.055 5.03E-6 0.20 2.500E-4 0.008 6.28E-6 0.25 2.500E-4 0.039 6.28E-6 0.25 3.000E-4 0.047 7.54E-6 0.30 3.000E-4 -0.056 7.54E-6 0.30 3.500E-4 -0.013 8.80E-6 0.35 3.500E-4 -0.021 8.80E-6 0.35 4.000E-4 -0.035 1.01E-5 0.40 4.000E-4 0.055 1.01E-5 0.40 4.500E-4 0.023 1.13E-5 0.45 4.500E-4 0.007 1.13E-5 0.45 5.000E-4 0.028 1.26E-5 0.50 5.000E-4 -0.049 1.26E-5 0.50 5.500E-4 -0.024 1.38E-5 0.55 5.500E-4 0.007 1.38E-5 0.55 6.000E-4 -0.017 1.51E-5 0.60 6.000E-4 0.043 1.51E-5 0.60 6.500E-4 0.027 1.63E-5 0.65 6.500E-4 -0.013 1.63E-5 0.65 7.000E-4 0.011 1.76E-5 0.70 7.000E-4 -0.033 1.76E-5 0.70 7.500E-4 -0.026 1.88E-5 0.75 7.500E-4 0.022 1.88E-5 0.75 8.000E-4 -4.272E-4 2.01E-5 0.80 8.000E-4 0.027 2.01E-5 0.80 8.500E-4 0.026 2.14E-5 0.85 8.500E-4 -0.022 2.14E-5 0.85 9.000E-4 -0.001 2.26E-5 0.90 9.000E-4 -0.016 2.26E-5 0.90 9.500E-4 -0.019 2.39E-5 0.95 9.500E-4 0.026 2.39E-5 0.95 0.001 0.009 2.51E-5 1.00 0.001 0.009 2.51E-5 1.00 0.001 0.017 2.64E-5 1.05 0.001 -0.022 2.64E-5 1.05 0.001 -0.010 2.76E-5 1.10 0.001 -0.002 2.76E-5 1.10 0.001 -0.011 2.89E-5 1.15 0.001 0.023 2.89E-5 1.15 0.001 0.013 3.02E-5 1.20 0.001 -0.002 3.02E-5 1.20 0.001 0.010 3.14E-5 1.25 0.001 -0.017 3.14E-5 1.25 0.001 -0.011 3.27E-5 1.30 0.001 0.007 3.27E-5 1.30 0.001 -0.002 3.39E-5 1.35 0.001 0.017 3.39E-5 1.35 0.001 0.013 3.52E-5 1.40 0.001 -0.008 3.52E-5 1.40 0.001 0.003 3.64E-5 1.45 0.001 -0.010 3.64E-5 1.45 0.002 -0.009 3.77E-5 1.50 0.002 0.012 3.77E-5 1.50 0.002 0.004 3.90E-5 1.55 0.002 0.010 3.90E-5 1.55 0.002 0.012 4.02E-5 1.60 0.002 -0.010 4.02E-5 1.60 0.002 -0.001 4.15E-5 1.65 0.002 -0.004 4.15E-5 1.65 0.002 -0.008 4.27E-5 1.70 0.002 0.012 4.27E-5 1.70 0.002 0.005 4.40E-5 1.75 0.002 0.004 4.40E-5 1.75 0.002 0.007 4.52E-5 1.80 0.002 -0.010 4.52E-5 1.80 0.002 -0.004 4.65E-5 1.85 0.002 0.003 4.65E-5 1.85 0.002 -0.001 4.78E-5 1.90 0.002 0.010 4.78E-5 1.90 0.002 0.005 4.90E-5 1.95 0.002 -0.002 4.90E-5 1.95 0.002 0.004 5.03E-5 2.00 0.002 -0.005 5.03E-5 2.00 0.002 -0.005 5.15E-5 2.05 0.002 0.006 5.15E-5 2.05 0.002 -9.155E-4 5.28E-5 2.10 0.002 0.006 5.28E-5 2.10 0.002 0.005 5.40E-5 2.15 0.002 -0.003 5.40E-5 2.15
也许这将有助于：
Function extractNumbers(line As String) As Variant Dim v As Variant Dim n As Long, i As Long Dim c As New Collection v = Split(line) For i = LBound(v) To UBound(v) If Len(v(i)) > 0 And IsNumeric(v(i)) Then c.Add v(i) Next i n = c.Count If n = 0 Then Exit Function v = Empty ReDim v(0 To n - 1) For i = 0 To n - 1 v(i) = CDbl(c.Item(i + 1)) Next i extractNumbers = v End Function Sub test(line As String) Dim i As Long Dim s As String Dim v As Variant v = extractNumbers(line) If Not IsEmpty(v) Then For i = 0 To UBound(v) s = s & " " & v(i) Next i Debug.Print Trim(s) Else Debug.Print "No numbers found" End If End Sub
典型输出：
test "Run #1 Run #1 Run #1 Run #1 Run #1 Run #2 Run #2 Run #2 Run #2 Run #2" No numbers found test "5.000E-5 -0.024 1.26E-6 0.05 5.000E-5 0.078 1.26E-6 0.05" 0.00005 -0.024 0.00000126 0.05 0.00005 0.078 0.00000126 0.05 test "5.000E-5 -0.024 bob 1.26E-6 0.05 5.000E-5 0.078 1.26E-6 0.05" 0.00005 -0.024 0.00000126 0.05 0.00005 0.078 0.00000126 0.05
你能用这个吗？
Option Explicit Public Sub SpecesToTabs() Const MAX_SPACES As Long = 10 Const FILE_NAME As String = "C:\test.txt" Dim fso As Object, txt As Object, dat As String, i As Long Set fso = CreateObject("Scripting.FileSystemObject") Set txt = fso.OpenTextFile(FILE_NAME) 'open file for reading dat = txt.ReadAll 'read entire file If Len(dat) > 0 Then For i = MAX_SPACES To 2 Step -1 dat = Replace(dat, Space(i), vbTab) 'replace space sets with tabs Next Set txt = fso.OpenTextFile(FILE_NAME, 2) 'open file for writing txt.Write dat 'write back to text file" End If End Sub
这是制表符分隔文件的结构：
。
您可以使用Split访问（和处理）每个数据元素
dat = Split(dat, vbCrLf) 'generates an array of lines dat = Split(dat, vbTab) 'generates an array of data items for each line