zoukankan      html  css  js  c++  java
  • VBA_Copy数据及数据格式_DoLoop删除空行

    Sub copyreport()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    Application.DisplayAlerts = False
        
    Dim wb, wb2 As Workbook
    Dim myFile As String, i As Long, lc As Long, lr As Long, lr1 As Long
    If LCase(get_R1_Run_by_Robot) = "y" Then thsmn.Range("B3") = vcrparms.Cells(5, "B")
    thswbk.Sheets("WD").Cells.Clear
    myFile = thsmn.Range("B3").Value
    If thsmn.Range("B3") <> "" Then
    
        Set wb = Workbooks.Open(fileName:=myFile)
        wb.Sheets("Bank Details Report").Range("A1:Z60000").Copy
        thswbk.Sheets("WD").Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
        wb.Sheets("Bank Details Report").Range("A1:Z60000").Copy
        thswbk.Sheets("WD").Range("A1").PasteSpecial xlPasteAllUsingSourceTheme
        wb.Sheets("Bank Details Report").Range("A1:Z60000").Copy
        thswbk.Sheets("WD").Range("A1").PasteSpecial xlPasteColumnWidths
        wb.Close False
        If LCase(get_R1_Run_by_Robot) = "n" Then MsgBox "Workday file has been uploaded!"
        
    End If
    thswbk.Sheets("Manual-Run").Activate
    ' Deleting the blank rows   
    lr = thswbk.Sheets("WD").Cells(Rows.Count, 1).End(xlUp).Row
    lr1 = thswbk.Sheets("WD").Cells(lr, 1).End(xlUp).Row - 1  '可以定位到数据区域的空行
    Do Until lr1 < 1                                          '所有涉及到删除行数据的操作都不要使用 for each和for range循环,会有指针问题导致的删错行。
        thswbk.Sheets("WD").Cells(lr1, 1).EntireRow.Delete    '删除空行
        lr1 = lr1 - 1
    Loop
    ' Adding New Formulas
    
    i = 2
    lr = thswbk.Worksheets("WD").Cells(Rows.Count, "A").End(xlUp).Row
    Do Until cfgsht.Cells(i, "O") = ""
        If cfgsht.Cells(i, "O") = "WD" Then
            lc = thswbk.Sheets("WD").Cells(1, Columns.Count).End(xlToLeft).Column + 1
            thswbk.Sheets("WD").Cells(1, lc) = cfgsht.Cells(i, "R")
            thswbk.Sheets("WD").Cells(1, lc - 1).Copy
            thswbk.Sheets("WD").Cells(1, lc).PasteSpecial xlPasteFormats
            thswbk.Sheets("WD").Cells(1, lc).EntireColumn.ColumnWidth = 20
            Application.CutCopyMode = False
            thswbk.Sheets("WD").Cells(2, lc) = "=" & cfgsht.Cells(i, "Q")
            thswbk.Sheets("WD").Cells(2, lc).AutoFill thswbk.Sheets("WD").Range(thswbk.Sheets("WD").Cells(2, lc), thswbk.Sheets("WD").Cells(lr, lc))
        End If
        i = i + 1
    Loop
    

    End Sub

    有用的代码 2:

    https://blog.csdn.net/hpdlzu80100/article/details/80735289

  • 相关阅读:
    使用CablleStatement调用存储过程
    权限问题
    全文检索lucene6.1的检索方式
    spring的JdbcTemplate
    spring使用注解开发
    IDEA的快捷键:
    IDEA里面的facets和artifacts的讲解
    Hibernate---criteria的具体使用列子
    关于操作日期函数及其取范围
    hibernate---crateria
  • 原文地址:https://www.cnblogs.com/Collin-pxy/p/13038848.html
Copyright © 2011-2022 走看看