Question

我需要减少代码，我会多次编写语法来复制和粘贴行值。

Private Sub btn_upload_Click()
'Frm_Mainform.Show
'MsgBox ("Process Complete - Please Check File in Output Folder")
Const FOLDER As String = "C:\SBI_Files\"

On Error GoTo ErrorHandler

Dim i As Integer
i = 18

Dim fileName As String

fileName = Dir(FOLDER, vbDirectory)

  Do While Len(fileName) > 0

If Right$(fileName, 4) = "xlsx" Or Right$(fileName, 3) = "xls" Then
    i = i + 1

    Dim currentWkbk As Excel.Workbook
     Set currentWkbk = Excel.Workbooks.Open(FOLDER & fileName)
     Cells(i, 1) = fileName
     Cells(i + 1, 2) = "Equity"
     Cells(i + 2, 2) = "Forex NOOP"
     Cells(i + 3, 2) = "Fixed   Income Securities  ( including CP, CD, G Sec)"
     Cells(i + 4, 2) = "Total"
     Cells(i, 2) = "Details"
     Cells(i, 3) = "Limit"
     Cells(i, 4) = "Min Var"
     Cells(i, 5) = "Max Var"
     Cells(i, 6) = "No. of Breaches"
     Cells(i + 1, 3) = currentWkbk.Sheets("VaR").Range("G8:G8").Value
     Cells(i + 1, 4) = currentWkbk.Sheets("VaR").Range("H8:H8").Value
     Cells(i + 1, 5) = currentWkbk.Sheets("VaR").Range("I8:I8").Value
     Cells(i + 1, 6) = currentWkbk.Sheets("VaR").Range("J8:J8").Value
     i = i + 1
     Cells(i + 1, 3) = currentWkbk.Sheets("VaR").Range("G9:G9").Value
     Cells(i + 1, 4) = currentWkbk.Sheets("VaR").Range("H9:H9").Value
     Cells(i + 1, 5) = currentWkbk.Sheets("VaR").Range("I9:I9").Value
     Cells(i + 1, 6) = currentWkbk.Sheets("VaR").Range("J9:J9").Value
     i = i + 1
     Cells(i + 1, 3) = currentWkbk.Sheets("VaR").Range("G10:G10").Value
     Cells(i + 1, 4) = currentWkbk.Sheets("VaR").Range("H10:H10").Value
     Cells(i + 1, 5) = currentWkbk.Sheets("VaR").Range("I10:I10").Value
     Cells(i + 1, 6) = currentWkbk.Sheets("VaR").Range("J10:J10").Value
     i = i + 1
     Cells(i + 1, 3) = currentWkbk.Sheets("VaR").Range("G11:G11").Value
     Cells(i + 1, 4) = currentWkbk.Sheets("VaR").Range("H11:H11").Value
     Cells(i + 1, 5) = currentWkbk.Sheets("VaR").Range("I11:I11").Value
     Cells(i + 1, 6) = currentWkbk.Sheets("VaR").Range("J11:J11").Value
     i = i + 1
     currentWkbk.Close
End If
fileName = Dir
Loop

ProgramExit:
   Exit Sub
ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit
End Sub

Answer 1

您可以用这4个

替换所有Cells行

更新：为应对格式添加了一行

 'other code
 Set currentWkbk = Excel.Workbooks.Open(FOLDER & fileName)
 Cells(i, 1) = fileName
 Cells(i + 1, 2).Resize(4, 1) = Application.Transpose(Array("Equity", "Forex NOOP", "Fixed   Income Securities  ( including CP, CD, G Sec)", "Total"))
 Cells(i, 2).Resize(1, 5) = Array("Details", "Limit", "Min Var", "Max Var", "No. of Breaches")
 Cells(i + 1, 3).Resize(4, 4) = currentWkbk.Sheets("VaR").Range("G8:J11").Value
 currentWkbk.Sheets("VaR").Range("G8:J11").Copy Cells(i + 1, 3)
 currentWkbk.Close

改进复制/粘贴的代码

1 个答案: