取值到表格，并生成新格式内容

olin12345

从文本文件中取符合要求的数据，并生成新格式内容。

gwjkkkkk

请参考。。。

olin12345

gwjkkkkk 发表于 2023-7-27 19:28
请参考。。。

感谢老师，新格式的后面有一截是不要的，传错附件了，麻烦老师再帮忙看看。

gwjkkkkk

olin12345 发表于 2023-7-27 19:46
感谢老师，新格式的后面有一截是不要的，传错附件了，麻烦老师再帮忙看看。

数值１这一列不要吗？

ykcbf1100

参与一下。。。

olin12345

gwjkkkkk 发表于 2023-7-27 20:36
数值１这一列不要吗？

对，前面那逗号和1都不要，后面就直接是时间

limonet

使用了：FileDialog、DO WHILE等待

limonet

Sub Limonet()
    Dim Cn As Object, StrSQL$, Path$, FileName$
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then Path = .SelectedItems(1) & "\" Else Exit Sub
    End With
    Set Cn = CreateObject("ADODB.Connection")
    FileName = Dir(Path & "*.txt")
    Do While FileName <> ""
        If Not FileName Like "New*" Then
            Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Text;FMT=Delimited';Data Source=" & Path
            StrSQL = "Select * From [" & FileName & "] Where Re>0"
            Range("A2").CopyFromRecordset Cn.Execute(StrSQL)
            Cn.Close
            Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
            Range("H2").CopyFromRecordset Cn.Execute("Select Left(Time,19) From [" & ActiveSheet.Name & "$H:H]")
            Cn.Close
            ActiveWorkbook.SaveAs FileName:=Path & "New-" & FileName, FileFormat:=xlCSV, CreateBackup:=False
        End If
        FileName = Dir
    Loop
End Sub

limonet

抱歉，第12行前加一行Range("A2:H999").ClearContents

gwjkkkkk

olin12345 发表于 2023-7-27 20:44
对，前面那逗号和1都不要，后面就直接是时间

有人帮你写了，我就不写了。。。