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

lhj323323

老师：

上传的附件里的写好的语句
能实现生成到同路径的txt里

现打算进行一些修正。如下图（但愿表述清楚了）


老师如有时间，请帮忙看看，先谢谢了
求助.rar (18.63 KB, 下载次数: 12)

2024-1-29 08:18 上传

点击文件名下载附件

蓝桥玄霜

文本的例子：

ykcbf1100

参与一下。。。

1. Sub test2()
   
2.     Dim Myr, i, j, s, k, t
   
3.     Dim arr, Str3$
   
4.     Dim d As Object
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     Application.ScreenUpdating = False
   
7.     With Sheet1
   
8.         Myr = .Range("a65536").End(xlUp).Row
   
9.         arr = .Range("a2:b" & Myr)
   
10.     End With
    
11.     For i = 1 To UBound(arr)
    
12.         s = Minute(arr(i, 2))
    
13.         If Not d.exists(s) Then Set d(s) = CreateObject("Scripting.Dictionary")
    
14.         d(s)(i) = i
    
15.     Next
    
16.     k = d.keys
    
17.     Str3 = "[COM]"
    
18.     For x = 0 To UBound(k) Step 2
    
19.         For Each kk In d(k(x)).keys
    
20.             Str3 = Str3 & Chr(10) & Format(arr(kk, 1), "000000") & "=7"
    
21.         Next
    
22.     Next
    
23.     Open ThisWorkbook.Path & "\测试.txt" For Output As #1
    
24.     Print #1, Str3
    
25.     Close #1
    
26.     Application.ScreenUpdating = True
    
27.     MsgBox "OK！"
    
28. End Sub

复制代码

ykcbf1100

附件供参考。。。

yynrzwh

求助.rar (17.08 KB, 下载次数: 8)

2024-1-29 09:41 上传

点击文件名下载附件

准提部林

Sub Test_A1()  'by.准提部林
Dim Arr, xD, i%, M, T$, K%
Set xD = CreateObject("scripting.dictionary")
Arr = Range([a1], [b65536].End(3))
For i = 2 To UBound(Arr)
    M = Minute(Arr(i, 2)): xD(M) = xD(M) + 1
    If xD(M) = 1 Then K = 1 - K
    If K = 1 Then T = T & vbCrLf & Arr(i, 1) & "=7"
Next
Open ThisWorkbook.Path & "\TEST999.txt" For Output As #1
Print #1, "[COM]" & T
Close #1
End Sub

准提部林

時間已排序, 且同一小時內//省去字典
Sub Test_A2()  'by.准提部林
Dim Arr, i%, M$, s$, T$, K%
Arr = Range([a1], [b65536].End(3))
For i = 2 To UBound(Arr)
    M = Minute(Arr(i, 2))
    If M <> s Then K = 1 - K: s = M
    If K = 1 Then T = T & vbCrLf & Arr(i, 1) & "=7"
Next
Open ThisWorkbook.Path & "\TEST999.txt" For Output As #1
Print #1, "[COM]" & T
Close #1
End Sub

lhj323323

ykcbf1100 发表于 2024-1-29 09:30
附件供参考。。。

ykcbf1100老师

首先感谢帮助！
4楼的代码运行是正确的。
请老师下载12楼的附件
但如果在运行程序前，同路径已存在这个【测试.txt】（现暂取名为原有内容.txt）
能否改为按如下标准（请看图片）运行？

求助7.rar (18.48 KB, 下载次数: 4)

2024-2-26 07:43 上传

点击文件名下载附件

ykcbf1100

lhj323323 发表于 2024-2-26 07:43
ykcbf1100老师

首先感谢帮助！

我等下看看再回复。

lhj323323

ykcbf1100 发表于 2024-2-26 07:53
我等下看看再回复。

好，昨天改写了一天，都没有成功，不知怎么绕不出来。