有没有一种正确的方法来执行此任务而无需使用自定义构建的子程序？
问题摘要
我在VBA中编写了一个excel宏，它导入一个大文本文件，读取每一行以确定要存储的数据的数量，为数组分配正确的大小来保存数据，然后再次打开文件将数据写入数组。
我遇到的这个程序的问题是大文本文件的行标签大小行不一致。我必须编写一个特殊的分隔过滤器函数来选择要存储到数组中的正确数据。
是否有正确的方法来执行此任务而无需使用自定义构建的子例程？
程序规范
程序必须执行数据分析，以便与以下模型$y_k = c_1 x_k + c_0 + c_{-1}(x_{k})^{-1}$进行最佳拟合，其中包括负指数。该程序不允许在退出后将数据保留在Excel电子表格中，但这并不意味着它不能暂时放置。性能和速度对于不耐烦的用户很重要。导入的数据可能具有未指定数量的重复列类型和未定义的制表符长度分隔符。
开放给建议
我愿意利用预定义的excel函数并暂时将数据存储在excel变量中。
确定文本文件
中的数据大小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
2 个答案:
答案 0 :(得分：1)
也许这会有所帮助：
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
答案 1 :(得分：1)
你能用吗？
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
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？