vba进行aci文本编辑处理

haopengxiang24

求助:vba进行aci文本编辑处理。
       涉及到aci文本固定位置的数据替换，替换的内容来源于excel表格中公式计算所得的数据。
       在aci文本中需要替换的内容是： 每个ACT下的INPUT         =  '0'位置处的0，分别对应于表格第20行开始每行G-R列的内容（蓝色区域，空单元格按0                                                    处理）。
      例如：event.aci文本中ACT_1部分的INPUT         =  '0'，由表格G20处计算得到的数据替换掉0；
                                    ACT_2部分的INPUT         =  '0'，由表格H20处计算得到的数据替换掉0；
                                    ACT_3部分的INPUT         =  '0'，由表格I20处计算得到的数据替换掉0；
                                    ACT_4部分的INPUT         =  '0'，由表格J20处计算得到的数据替换掉0；
                                    ......
                                    ACT_12部分的INPUT         =  '0'，由表格R20处计算得到的数据替换掉0。
                                    第一行数据替换完成后就保存文本，文本名称为event1；
                          下一行，
                                   各个INPUT         =  '0'由第21行的G21-R21的12个数据替换掉，
                                   第二行替换完成后就保存文本，文本名称为event2；
      依次处理，一共循环21次。最后应生成21个aci文本。
感谢各位大神能在百忙之中帮我一下，谢谢。

一把小刀闯天下

'替换了12次为什么会输出21个文件？反正就这方法自己修改。

Option Explicit

Sub test()
  Dim arr, pth, i, j, k, n, brr
  pth = ThisWorkbook.Path & "\"
  brr = Sheets("底盘工况").[g20:r20] '可以支持更多数据
  Open pth & "event.aci" For Input As #1
  arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbNewLine)
  Close #1
  For i = 0 To UBound(arr)
    n = n + 1
    If n > UBound(brr, 2) Then Exit Sub '13个ACT对应12个数据，数据量不够
    For j = i To UBound(arr) '如果无序把i改成0
      If InStr(arr(j), "ACT_" & n) Then
        For k = j To UBound(arr)
          If InStr(arr(k), "INPUT") Then
            If Len(brr(1, n)) > 0 Then arr(k) = Replace(arr(k), "0", brr(1, n))
            Open pth & "event" & n & ".aci" For Output As #1
            Print #1, Join(arr, vbNewLine)
            Close #1
            j = UBound(arr): i = k: Exit For
          End If
        Next
      End If
  Next j, i
End Sub

一把小刀闯天下

'也可能是这结果，每次替换保存后数组作初始化。楼上的代码未做初始化，自己选

Option Explicit

Sub test()
  Dim arr, pth, i, j, k, n, brr, crr
  pth = ThisWorkbook.Path & "\"
  brr = Sheets("底盘工况").[g20:r20] '可以支持更多数据
  Open pth & "event.aci" For Input As #1
  crr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbNewLine)
  Close #1
  For i = 0 To UBound(crr)
    n = n + 1: arr = crr
    If n > UBound(brr, 2) Then Exit Sub '13个ACT对应12个数据，数据量不够
    For j = i To UBound(crr) '如果无序把i改成0
      If InStr(arr(j), "ACT_" & n) Then
        For k = j To UBound(crr)
          If InStr(arr(k), "INPUT") Then
            If Len(brr(1, n)) > 0 Then arr(k) = Replace(arr(k), "0", brr(1, n))
            Open pth & "event" & n & ".aci" For Output As #1
            Print #1, Join(arr, vbNewLine)
            Close #1
            j = UBound(crr): i = k: Exit For
          End If
        Next
      End If
  Next j, i
End Sub

haopengxiang24

一把小刀闯天下 发表于 2018-6-21 06:23
'替换了12次为什么会输出21个文件？反正就这方法自己修改。

Option Explicit

先谢谢您啦。文本中的第13个0是勿需替换的，也就是还是0.
                  12个数据的替换是基于蓝色区域的每一行，所以应该正好是21行。
                  这个程序有点复杂，我试了一下，但是不怎么会改。麻烦您再帮我看看，谢谢

haopengxiang24

一把小刀闯天下 发表于 2018-6-21 06:37
'也可能是这结果，每次替换保存后数组作初始化。楼上的代码未做初始化，自己选

Option Explicit

您指的是哪个数组，是指TNPUT出的替换内容么

haopengxiang24

一把小刀闯天下 发表于 2018-6-21 06:23
'替换了12次为什么会输出21个文件？反正就这方法自己修改。

Option Explicit

替换的是蓝色区域的每一行，一行12个数据，第13个不用替换（或者按0替换）。

lsdongjh

你的所谓aci文件，其结构实质上 是一个 ini 文件，直接用 WritePrivateProfileString 这个API读写就成了

lsdongjh

1. Private Declare PtrSafe Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
   
2. 
   
3. Sub Test2()
   
4.     Dim strSourceFileName As String
   
5.     Dim strDestinationFile As String
   
6.     Dim arrSource As Variant
   
7.     Dim lngRow As Long, lngCol As Long
   
8.     Dim strAppName As String, strKeyName As String, strVal As String
   
9.     Dim blIsOk As Long
   
10.    
    
11.     strSourceFileName = ThisWorkbook.Path & "\event.aci"
    
12.     arrSource = Sheet2.Range("G20:R37")
    
13.    
    
14.     For lngRow = 1 To UBound(arrSource)
    
15.         strDestinationFile = ThisWorkbook.Path & "\event-" & lngRow & ".aci"
    
16.         If Dir(strDestinationFile) <> "" Then Kill strDestinationFile
    
17.         FileCopy strSourceFileName, strDestinationFile
    
18.         
    
19.         For lngCol = 1 To UBound(arrSource, 2)
    
20.             strAppName = "ACT_" & lngCol '段名
    
21.             strKeyName = "INPUT" '键名
    
22.             strVal = Space(2) & "'" & Val(arrSource(lngRow, lngCol)) & "'" '键值
    
23.             
    
24.             blIsOk = WritePrivateProfileString(strAppName, strKeyName, strVal, strDestinationFile)
    
25.         Next
    
26.     Next
    
27. End Sub
    

复制代码

一把小刀闯天下

haopengxiang24 发表于 2018-6-21 10:10
替换的是蓝色区域的每一行，一行12个数据，第13个不用替换（或者按0替换）。

'好像看懂了，再试一下：

Option Explicit

Sub test()
  Dim arr, pth, i, j, k, n, brr, crr, ii, m
  pth = ThisWorkbook.Path & "\"
  With Sheets("底盘工况")
    brr = Range("f20:r20" & .Cells(Rows.Count, "f").End(xlUp).Row)
  End With
  Open pth & "event.aci" For Input As #1
  crr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbNewLine)
  Close #1
  For ii = 1 To UBound(brr, 1)
    If Len(brr(ii, 1)) Then
      arr = crr: m = m + 1: n = 0
      For i = 0 To UBound(crr)
        n = n + 1
        If n + 1 > UBound(brr, 2) Then Exit For
        For j = i To UBound(crr)
          If InStr(arr(j), "ACT_" & n) Then
            For k = j To UBound(crr)
              If InStr(arr(k), "INPUT") Then
                If Len(brr(ii, n + 1)) > 0 Then arr(k) = Replace(arr(k), "0", brr(ii, n + 1))
                j = UBound(crr): i = k: Exit For
              End If
            Next
          End If
      Next j, i
      Open pth & "event" & m & ".aci" For Output As #1
      Print #1, Join(arr, vbNewLine)
      Close #1
    End If
  Next
End Sub

haopengxiang24

一把小刀闯天下 发表于 2018-6-21 11:05
'好像看懂了，再试一下：

Option Explicit

嗯，测试结果是正常的，非常感谢。还有点小问题，就是蓝色区域中有一行是空数据，并且第H、K、N、Q这四列的数据应该取相反值，然后在进行替换。不知道这几步能不能加进去。