求大师vba代码

Question

用Excel读取一个 1.txt文件，
将他的 第2行3列，
第3行3列
第4行4列的三个数据，分别写到
sheet1 的第二行的 3/4/5 三个单元格
同理，再把 2.txt的对应文件，读取到，sheet2 对应的单元格里
每隔5秒刷新一次

Answer 1

Dim i As Long
Dim NextTick As Date
Sub add_data()

Dim Path As String, MyValue As String, fn As Long
Path = "E:\personal\VBA" '假定你的文件处在C:\tmp 文件夹中，可以自行修改
fn = FreeFile
RowI = 3
fname = Dir(Path & "\*.txt")
If fname <> "" Then
Do
Open Path & "\" & fname For Input As #fn
Row = 0
Do Until EOF(fn)
Line Input #fn, Data
Data = Trim(Data)
If Data <> "" Then Row = Row + 1
If Row = 2 Then Exit Do '这里2表示表示提取第2行的数据
Loop

If Data <> "" And Row = 2 Then
Data = Replace(Data, " ", vbTab)
Data = Replace(Data, vbTab & vbTab, vbTab)
Data = Split(Data, vbTab)
n = UBound(Data)
If n >= 1 And Trim(Data(0)) <> "" Then '提取第2行第1列数据填充到单元格的第2列中
On Error Resume Next
Sheet1.Cells(RowI, 2).Value = Data(0)
If Err.Number Then
Sheet1.Cells(RowI, 2) = Data(0)
End If
End If
If n >= 2 And Trim(Data(1)) <> "" Then '提取第2行第2列数据填充到单元格的第3列中
On Error Resume Next
Sheet1.Cells(RowI, 3).Value = Data(1)
If Err.Number Then
Sheet1.Cells(RowI, 3) = Data(1)
End If
End If
If n >= 3 And Trim(Data(2)) <> "" Then '提取第2行第3列数据填充到单元格的第4列中
On Error Resume Next
Sheet1.Cells(RowI, 4).Value = Data(2)
If Err.Number Then
Sheet1.Cells(RowI, 4) = Data(2)
End If
End If
If n >= 4 And Trim(Data(3)) <> "" Then '提取第2行第4列数据填充到单元格的第5列中
On Error Resume Next
Sheet1.Cells(RowI, 5).Value = Data(3)
If Err.Number Then
Sheet1.Cells(RowI, 5) = Data(3)
End If
End If
End If
Row = 2
Do Until EOF(fn)
Line Input #fn, Data
Data = Trim(Data)
If Data <> "" Then Row = Row + 1
If Row = 3 Then Exit Do '这里3表示表示提取第3行的数据
Loop

If Data <> "" And Row = 3 Then
Data = Replace(Data, " ", vbTab)
Data = Replace(Data, vbTab & vbTab, vbTab)
Data = Split(Data, vbTab)
n = UBound(Data)
If n >= 4 And Trim(Data(3)) <> "" Then '提取第3行第4列数据填充到单元格的第6列中
On Error Resume Next
Sheet1.Cells(RowI, 6).Value = Data(3)
If Err.Number Then
Sheet1.Cells(RowI, 6) = Data(3)
End If
End If
End If
Row = 3
Do Until EOF(fn)
Line Input #fn, Data
Data = Trim(Data)
If Data <> "" Then Row = Row + 1
If Row = 4 Then Exit Do '这里4表示表示提取第4行的数据
Loop

If Data <> "" And Row = 4 Then
Data = Replace(Data, " ", vbTab)
Data = Replace(Data, vbTab & vbTab, vbTab)
Data = Split(Data, vbTab)
n = UBound(Data)
If n >= 4 And Trim(Data(3)) <> "" Then '提取第4行第4列数据填充到单元格的第7列中
On Error Resume Next
Sheet1.Cells(RowI, 7).Value = Data(3)
If Err.Number Then
Sheet1.Cells(RowI, 7) = Data(3)
End If
End If
End If
Row = 4
Do Until EOF(fn)
Line Input #fn, Data
Data = Trim(Data)
If Data <> "" Then Row = Row + 1
If Row = 5 Then Exit Do '这里5表示表示提取第5行的数据
Loop

If Data <> "" And Row = 5 Then
Data = Replace(Data, " ", vbTab)
Data = Replace(Data, vbTab & vbTab, vbTab)
Data = Split(Data, vbTab)
n = UBound(Data)
If n >= 4 And Trim(Data(3)) <> "" Then '提取第5行第4列数据填充到单元格的第8列中
On Error Resume Next
Sheet1.Cells(RowI, 8).Value = Data(3)
If Err.Number Then
Sheet1.Cells(RowI, 8) = Data(3)
End If
End If
End If
Row = 5
Do Until EOF(fn)
Line Input #fn, Data
Data = Trim(Data)
If Data <> "" Then Row = Row + 1
If Row = 6 Then Exit Do '这里6表示表示提取第6行的数据
Loop

If Data <> "" And Row = 6 Then
Data = Replace(Data, " ", vbTab)
Data = Replace(Data, vbTab & vbTab, vbTab)
Data = Split(Data, vbTab)
n = UBound(Data)
If n >= 4 And Trim(Data(3)) <> "" Then '提取第6行第4列数据填充到单元格的第9列中
On Error Resume Next
Sheet1.Cells(RowI, 9).Value = Data(3)
If Err.Number Then
Sheet1.Cells(RowI, 9) = Data(3)
End If
End If
End If
Row = 6
Do Until EOF(fn)
Line Input #fn, Data
Data = Trim(Data)
If Data <> "" Then Row = Row + 1
If Row = 7 Then Exit Do '这里7表示表示提取第7行的数据
Loop

If Data <> "" And Row = 7 Then
Data = Replace(Data, " ", vbTab)
Data = Replace(Data, vbTab & vbTab, vbTab)
Data = Split(Data, vbTab)
n = UBound(Data)
If n >= 4 And Trim(Data(3)) <> "" Then '提取第7行第4列数据填充到单元格的第10列中
On Error Resume Next
Sheet1.Cells(RowI, 10).Value = Data(3)
If Err.Number Then
Sheet1.Cells(RowI, 10) = Data(3)
End If
End If
End If

Close #fn
RowI = RowI + 1
fname = Dir()
Loop While fname <> ""
ActiveWorkbook.Save

NextTick = Now + TimeValue("00:00:01")
Application.OnTime NextTick, "add_data"
End If
End Sub
Sub 结束()
On Error Resume Next
Application.OnTime NextTick, "add_data", , False
End Sub
Private Sub Form_Load()
Timer1.Interval = 1000
End Sub
Private Sub Timer1_Timer()
i = i + 1
If i Mod 300 = 0 Then
i = 0
Call add_data
End If
End Sub
小小意思，忘对你有帮助；
无需收费，忘施主好好学习

Answer 2

有

可以考虑

追问

5元￥，没有财富值

追答

加个零可以考虑

Answer 3

去这里有很多VBA模板哦：三个w点2xx点vip 多下载 多学习 应该对你有帮助的