VBA编程实现EXECL根据表2数据修改表1

来源:互联网 发布:php 清空输出缓存 编辑:程序博客网 时间:2024/06/05 11:31
‘在做的PLC项目中,需要将PLC中的所有数据提出来,我们知道符号表中定义的变量可能是不全的,而且有些符号表中有,而程序中没有使用。交叉引用表中的数据是全的但    ’是没有注释,那我可以写个程序根据交叉引用表来修改符号表(符号表中有交叉引用中没有的删掉,交叉引用中有而符号表中没有的在符号表中加上)
‘下面是程序:
Sub Split_String()'在使用此程序前,请先将符号表中的数据和交叉引用中的数据分别排好序    Dim a    Dim myChars(1 To 11)    Dim k, n As Integer    Dim s As String    For i = 1 To [b65536].End(xlUp).Row'这里是从第一行到有数据的最后一行        a = Split(Cells(i, 1).Value, "(")'根据"("分割字符串,因为交叉引用表中的第一列是这样的I 0.0 (QF1)        Cells(i, 2).Value = a(0)'提取出前面的I0.0放到B列        Cells(i, 2) = Application.WorksheetFunction.Substitute(Cells(i, 2), " ", "") //将B列中的空格去掉            Next            For i = 1 To [b65536].End(xlUp).Row'这里是将"I0.0"这样的变量统一成"I      0.0"这样的格式,否则对比时会出现错误(重点在于固定长度)        For n = 1 To 11            myChars(n) = Mid(Worksheets("Sheet2").Cells(i, 2), n, 1)            If myChars(n) = "." Then                k = n            End If        Next    For j = 11 To 3 Step -1        myChars(j) = myChars(j - 1)    Next    myChars(2) = " "    For j = 11 - k To 3 Step -1        For n = 11 To 3 Step -1        myChars(n) = myChars(n - 1)        Next    Next    s = Join(myChars, "")    Worksheets("Sheet2").Cells(i, 2) = s    Next                            For i = 1 To [b65536].End(xlUp).Row'为了不改动原数据将表1中的地址栏从B列复制到F列        Worksheets("Sheet1").Cells(i, 6) = Application.WorksheetFunction.Substitute(Worksheets("Sheet1").Cells(i, 2), " ", "")    Next        For i = 1 To [b65536].End(xlUp).Row'同上,整理格式,统一成一共11个字节        For n = 1 To 11            myChars(n) = Mid(Worksheets("Sheet1").Cells(i, 6), n, 1)            If myChars(n) = "." Then                k = n            End If        Next    For j = 11 To 3 Step -1        myChars(j) = myChars(j - 1)    Next    myChars(2) = " "    For j = 11 - k To 3 Step -1        For n = 11 To 3 Step -1        myChars(n) = myChars(n - 1)        Next    Next    s = Join(myChars, "")    Worksheets("Sheet1").Cells(i, 6) = s    Next        For i = 1 To [b65536].End(xlUp).Row        If Worksheets("Sheet2").Cells(i, 2) > Worksheets("Sheet1").Cells(i, 6) Then            If Worksheets("Sheet1").Cells(i, 6) = "" Then                Exit For            Else                            Worksheets("Sheet1").Rows(i).Delete                i = i - 1            End If        ElseIf Worksheets("Sheet2").Cells(i, 2) < Worksheets("Sheet1").Cells(i, 6) Then              Worksheets("Sheet1").Rows(i).Insert                                   Worksheets("Sheet1").Cells(i, 2) = Worksheets("Sheet2").Cells(i, 2)            Worksheets("Sheet1").Cells(i, 6) = Worksheets("Sheet2").Cells(i, 2)                       Else            Worksheets("Sheet2").Cells(i, 3) = 1                  End If                            NextEnd Sub

                                             
0 0