提取变化次数是奇数的记录，生成到同路径txt，谢谢ykcbf1100和准提部林老师！

lhj323323 · 发表于 2024-2-27 19:06

准提部林发表于 2024-2-27 18:22
A列數字都是6位數(格式為000000), 與文字檔對不上~~

是的老师

所以还不能用InStr来判断

至于与文字档对不上
在[COM]里，有两笔是对上了的，即
000619和300334

lhj323323 · 发表于 2024-2-27 19:10

准提部林发表于 2024-2-27 18:22
A列數字都是6位數(格式為000000), 與文字檔對不上~~

是的老师
在定义格式（前）
Format(arr2(i, 1), "000000")

可能得先与[COM]项下的（等号之左）的值，进行匹配

准提部林 · 发表于 2024-2-27 20:47

lhj323323 发表于 2024-2-27 19:10
是的老师
在定义格式（前）
Format(arr2(i, 1), "000000")

原文字檔[com]部份,不足6位數的, 是否也要format成6位數存回去???

准提部林 · 发表于 2024-2-27 21:10

lhj323323 发表于 2024-2-27 19:10
是的老师
在定义格式（前）
Format(arr2(i, 1), "000000")

文字檔替換+補齊// 全改成000000格式
1) 原檔名稱暫用"TEST.TXT"
2) 原檔不替換, 產生一個新檔(New)

Sub Test_A1()  'by.准提部林
Dim Arr, xD, vD, i%, M, T$, P$, Pr, TT$, S%, K%
Set xD = CreateObject("scripting.dictionary")
Set vD = CreateObject("scripting.dictionary")
Arr = Range(Sheet1.[a1], Sheet1.[b65536].End(3))
For i = 2 To UBound(Arr)
T = Format(Arr(i, 1), "000000")
M = Minute(Arr(i, 2))
xD(M) = xD(M) + 1
If xD(M) = 1 Then K = 1 - K
If K = 1 Then vD(T) = T & "=7"
Next
'----------------------
Open ThisWorkbook.Path & "\TEST.TXT" For Input As #1
Do Until EOF(1)
Line Input #1, T
If T = "[COM]" Then S = 1: GoTo 101
If S = 1 Then
   If Left(T, 1) = "[" Then
      For Each M In vD.items
         TT = TT & vbCrLf & M
      Next M
      S = 0
   Else
      Pr = Split(T & "=", "=")
      P = Format(Pr(0), "000000")
      T = P & "=" & Pr(1)
      If vD.Exists(P) Then T = vD(P): vD.Remove P
   End If
End If
101:
TT = TT & vbCrLf & T
Loop
Close #1
'----------------------
Open ThisWorkbook.Path & "\TEST(New).txt" For Output As #1
Print #1, Mid(TT, 3)
Close #1
End Sub

lhj323323 · 发表于 2024-2-28 07:06

准提部林发表于 2024-2-27 20:47
原文字檔[com]部份,不足6位數的, 是否也要format成6位數存回去???

31楼的回复，直到22：50才被审核通过。
太慢了。

lhj323323 · 发表于 2024-2-28 07:08

准提部林发表于 2024-2-27 20:47
原文字檔[com]部份,不足6位數的, 是否也要format成6位數存回去???

不能。
导回到txt的所有涉及股票代码的，都不能按format的格式导回去
因为，针对txt的后续的使用，有些并没有按6位格式来提取。

lhj323323 · 发表于 2024-2-28 07:23

准提部林发表于 2024-2-27 21:10
文字檔替換+補齊// 全改成000000格式
1) 原檔名稱暫用"TEST.TXT"
2) 原檔不替換, 產生一個新檔(New)

谢谢老师！
测试成功了

请问
Print #1, Mid(TT, 3)
里的3，是什么意思，为何不是2呢？

lhj323323 · 发表于 2024-2-28 08:15

准提部林发表于 2024-2-27 21:10
文字檔替換+補齊// 全改成000000格式
1) 原檔名稱暫用"TEST.TXT"
2) 原檔不替換, 產生一個新檔(New)

老师：
请看下图

ykcbf1100 · 发表于 2024-2-28 08:53

lhj323323 发表于 2024-2-27 07:59
好，麻烦老师了

保留原代码，用于生成第一次测试.txt文件以减少操作，新代码用于替换和补充新数据。

附件供参考。。。

ykcbf1100 · 发表于 2024-2-28 08:54

更新代码。。。

Sub test8() '//2024.2.28
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
p = ThisWorkbook.Path & ""
Call test3
Set wb = Workbooks.Open(p & "测试.txt", 0)
With wb.Sheets(1)
zrr = .UsedRange
End With
wb.Close 0
For i = 2 To UBound(zrr)
s = Left(zrr(i, 1), 6)
d1(s) = Right(zrr(i, 1), 1)
Next
Set wb = Workbooks.Open(p & "原有内容.txt", 0)
With wb.Sheets(1)
r = .Cells(Rows.Count, 1).End(3).Row
r1 = .Columns("a:a").Find("[LINK]", , , , , 1).Row
ar = .Range("a1:a" & r1 - 1)
br = .Range(.Cells(r1, 1), .Cells(r, 1))
End With
wb.Close 0
ReDim brr(1 To 1000, 0)
For i = 1 To UBound(ar)
s = Left(ar(i, 1), 6)
m = m + 1
If d1.exists(s) Then
brr(m, 0) = s & "=" & d1(s)
Else
brr(m, 0) = ar(i, 1)
End If
Next
On Error Resume Next
st = ""
For i = 2 To UBound(brr)
s = Left(brr(i, 0), 6)
If d1.exists(s) Then
st = st & "|" & s
End If
Next
For i = 2 To UBound(zrr)
s = Left(brr(i, 0), 6)
If InStr(st, s) = 0 Then
m = m + 1
brr(m, 0) = zrr(i, 1)
End If
Next
For i = 1 To UBound(br)
m = m + 1
brr(m, 0) = br(i, 1)
Next
Set wb = Workbooks.Open(p & "测试.txt", 0)
With wb.Sheets(1)
.UsedRange = ""
.[a1].Resize(m, 1) = brr
End With
wb.Close 1
Application.ScreenUpdating = True
MsgBox "OK！"
End Sub

复制代码

		自动登录	找回密码
密码			免费注册

[已解决] 提取变化次数是奇数的记录，生成到同路径txt，谢谢ykcbf1100和准提部林老师！

评分

评分

点评

评分