• VBA文件操作


    做这些东西主要是为了,实现,我们的最终目标。

    查到 两个大表里面的变化数据。

    所以 这次

    ①实现了 文件操作的一部分内容。

    包括,excel的打开。分四个步骤。

    1、路径

    2、打开工作博

    3、操作

    4、关闭工作簿

    ②路径里面 包括 文件 是否 存在 的判断逻辑,如果 文件不存在,要记得 终止函数。

    ③以及 for 循环的 书写。还有 如果 到达了 查找目的以后,退出 for循环。

    布局的创建。

    判断文件存在的效果图

    最终结果图

    Sub 矩形1_Click()
    '
    ' 矩形1_Click Macro
    '
    
    Dim strPath1 As String
    Dim strPath2 As String
    Dim strFilename1 As String
    Dim strFilename2 As String
    Dim strFile1 As String
    Dim strFile2 As String
    
    
    strPath1 = Cells(3, 2)
    strPath2 = Cells(4, 2)
    strFilename1 = Cells(3, 3)
    strFilename2 = Cells(4, 3)
    
    strFile1 = strPath1 & "/" & strFilename1
    strFile2 = strPath2 & "/" & strFilename2
    
    If Dir(strFile1) = "" Then
        MsgBox "The target file :" & vbCrLf & strFile1 & 
    
    vbCrLf & "is NOT exist!"
        Exit Sub
    Else
        MsgBox "The target file :" & vbCrLf & strFile1 & 
    
    vbCrLf & "is exist!"
    End If
    
        
    End Sub
    
    
    ===============================step 2
    
    
    Sub 矩形1_Click()
    '
    ' 矩形1_Click Macro
    '
    
    Dim strPath1 As String
    Dim strPath2 As String
    Dim strFilename1 As String
    Dim strFilename2 As String
    Dim strFile1 As String
    Dim strFile2 As String
    
    
    strPath1 = Cells(3, 2)
    strPath2 = Cells(4, 2)
    strFilename1 = Cells(3, 3)
    strFilename2 = Cells(4, 3)
    
    strFile1 = strPath1 & "/" & strFilename1
    strFile2 = strPath2 & "/" & strFilename2
    
    If Dir(strFile1) = "" Then
        MsgBox "The target file :" & vbCrLf & strFile1 & 
    
    vbCrLf & "is NOT exist!"
        Exit Sub
    Else
        MsgBox "The target file :" & vbCrLf & strFile1 & 
    
    vbCrLf & "is exist!"
    End If
    
    '判定文件是否 存在 2
    
    Dim excel As Object
    Dim sheet As Object
    Dim Workbook As Object
    
    
    Set excel = CreateObject("excel.application")
    Set Workbook = excel.Workbooks.Open(strFile1)
    Set sheet = Workbook.ActiveSheet
    
    Cells(7, 4) = sheet.Cells(1, 1)
    
    
        
    End Sub
    
    
    =============================step 3
    
    Sub 矩形1_Click()
    '
    ' 矩形1_Click Macro
    '
    
    Dim strPath1 As String
    Dim strPath2 As String
    Dim strFilename1 As String
    Dim strFilename2 As String
    Dim strFile1 As String
    Dim strFile2 As String
    
    
    strPath1 = Cells(3, 2)
    strPath2 = Cells(4, 2)
    strFilename1 = Cells(3, 3)
    strFilename2 = Cells(4, 3)
    
    strFile1 = strPath1 & "/" & strFilename1
    strFile2 = strPath2 & "/" & strFilename2
    
    If Dir(strFile1) = "" Then
        MsgBox "The target file :" & vbCrLf & strFile1 & 
    
    vbCrLf & "is NOT exist!"
        Exit Sub
    Else
        MsgBox "The target file :" & vbCrLf & strFile1 & 
    
    vbCrLf & "is exist!"
    End If
    
    '判定文件是否 存在 2
    
    Dim excel As Object
    Dim sheet As Object
    Dim Workbook As Object
    
    
    Set excel = CreateObject("excel.application")
    Set Workbook = excel.Workbooks.Open(strFile1)
    Set sheet = Workbook.ActiveSheet
    
    Cells(7, 4) = sheet.Cells(1, 1)
    
    
    '查找项目
    Dim changedItemCol As Integer
    
    For changedItemCol = 1 To 20
        If sheet.Cells(1, changedItemCol) = "列4" Then
        Exit For
        End If
    Next changedItemCol
    
    Cells(16, 5) = 1
    Cells(17, 5) = changedItemCol
    
    
        
    End Sub
    ================================================step 4
    
    Sub 矩形1_Click()
    '
    ' 矩形1_Click Macro
    '
    ' getFile
    Dim strPath1 As String
    Dim strPath2 As String
    Dim strFilename1 As String
    Dim strFilename2 As String
    Dim strFile1 As String
    Dim strFile2 As String
    
    
    strPath1 = Cells(3, 2)
    strPath2 = Cells(4, 2)
    strFilename1 = Cells(3, 3)
    strFilename2 = Cells(4, 3)
    
    strFile1 = strPath1 & "/" & strFilename1
    strFile2 = strPath2 & "/" & strFilename2
    
    If Dir(strFile1) = "" Then
        MsgBox "The target file :" & vbCrLf & strFile1 & 
    
    vbCrLf & "is NOT exist!"
        Exit Sub
    'Else
    '   MsgBox "The target file :" & vbCrLf & strFile1 & 
    
    vbCrLf & "is exist!"
    End If
    
    If Dir(strFile2) = "" Then
        MsgBox "The target file :" & vbCrLf & strFile2 & 
    
    vbCrLf & "is NOT exist!"
        Exit Sub
    'Else
    '    MsgBox "The target file :" & vbCrLf & strFile1 & 
    
    vbCrLf & "is exist!"
    End If
    
    'get workbook and sheet
    
    Dim excel1 As Object
    Dim sheet1 As Object
    Dim Workbook1 As Object
    
    
    Set excel1 = CreateObject("excel.application")
    Set Workbook1 = excel1.Workbooks.Open(strFile1)
    Set sheet1 = Workbook1.ActiveSheet
    
    Dim excel2 As Object
    Dim sheet2 As Object
    Dim Workbook2 As Object
    
    
    Set excel2 = CreateObject("excel.application")
    Set Workbook2 = excel2.Workbooks.Open(strFile2)
    Set sheet2 = Workbook2.ActiveSheet
    
    
    'find Item
    Dim changedItemName As String
    Dim itemName1 As String
    Dim itemName2 As String
    
    
    itemName1 = Cells(10, 2)
    itemName2 = Cells(11, 2)
    changedItemName = Cells(13, 2)
    '循环一次,判定多次好,还是 循环多次判定一次好。。。
    '现在我就想吃饭,无所谓了。。。反正也不是什么大体量的工
    
    作。不用纠结这个
    
    Dim col As Integer
    '变更前
    For col = 1 To 20
        If sheet1.Cells(1, col) = itemName1 Then
        Exit For
        End If
    Next col
    
    Cells(7, 4) = itemName1
    Cells(8, 5) = 1
    Cells(9, 5) = col
    
    
    For col = 1 To 20
        If sheet1.Cells(1, col) = itemName2 Then
        Exit For
        End If
    Next col
    
    Cells(11, 4) = itemName1
    Cells(12, 5) = 1
    Cells(13, 5) = col
    
    For col = 1 To 20
        If sheet1.Cells(1, col) = changedItemName Then
        Exit For
        End If
    Next col
    
    Cells(15, 4) = changedItemName
    Cells(16, 5) = 1
    Cells(17, 5) = col
    
    
    '变更后
    For col = 1 To 20
        If sheet2.Cells(1, col) = itemName1 Then
        Exit For
        End If
    Next col
    
    Cells(7, 6) = itemName1
    Cells(8, 7) = 1
    Cells(9, 7) = col
    
    
    For col = 1 To 20
        If sheet2.Cells(1, col) = itemName2 Then
        Exit For
        End If
    Next col
    
    Cells(11, 6) = itemName1
    Cells(12, 7) = 1
    Cells(13, 7) = col
    
    For col = 1 To 20
        If sheet2.Cells(1, col) = changedItemName Then
        Exit For
        End If
    Next col
    
    Cells(15, 6) = changedItemName
    Cells(16, 7) = 1
    Cells(17, 7) = col

    Set sheet1 = Nothing
    Set sheet2 = Nothing
    Set Workbook1 = Nothing
    Set Workbook2 = Nothing
    Set excel1 = Nothing
    Set excel2 = Nothing

    End Sub

    参考文献

  • 相关阅读:
    设备内核PROBE函数何时调用
    对象最小JAVA对象排序之获取最小负载数
    网页内容设置有用的meta设置解决网页内容不能适应某些浏览器宽度的问题
    定义提示【Cocos2DX 游戏引擎】常见错误备忘
    绑定列ORA24816: 在实际的 LONG 或 LOB 列之后提供了扩展的非 LONG 绑定数据
    PowerShell
    boot.ini 调试模式
    windbg远程调试
    TLogger日志类
    pageheap检查对操作错误
  • 原文地址:https://www.cnblogs.com/letben/p/12006355.html
Copyright © 2020-2023  润新知