清除内容并调整某些行和列的大小

时间:2014-01-02 09:22:16

标签: excel vba excel-vba

当我不使用第一个命令清除内容时,代码工作正常。清除内容后,当我使用命令合并某些行和列时,我得到了“粘贴特殊错误”。我需要减小某些行的大小行和列(换行文本)占用大量空间

Private Sub Btn_clear_Click()
ThisWorkbook.Worksheets("Main").Cells.ClearContents
End Sub

(我能够使用此清除细胞内容)

Sub Credit_Risk_Components()

Const FOLDER As String = "C:\SBI_Files\"
Const cStrWSName As String = "Credit Risk Components"
'(I got a paste value error here)
On Error GoTo ErrorHandler

Dim i As Integer
Dim fileName As String


' Cleaning Credit Indicators (Both amount and percentage) '
ThisWorkbook.Worksheets(cStrWSName).Range("C8:C16").ClearContents
ThisWorkbook.Worksheets(cStrWSName).Range("C20").ClearContents
ThisWorkbook.Worksheets(cStrWSName).Range("C23:C25").ClearContents
ThisWorkbook.Worksheets(cStrWSName).Range("C40:C47").ClearContents
ThisWorkbook.Worksheets(cStrWSName).Range("C52:C59").ClearContents
ThisWorkbook.Worksheets(cStrWSName).Range("C66").ClearContents
ThisWorkbook.Worksheets(cStrWSName).Range("C68").ClearContents
ThisWorkbook.Worksheets(cStrWSName).Range("C71:C73").ClearContents

'Cleaning the Annexure Section'
ThisWorkbook.Worksheets(cStrWSName).Range("H6:K200").UnMerge
ThisWorkbook.Worksheets(cStrWSName).Range("H6:K200").ClearFormats
ThisWorkbook.Worksheets(cStrWSName).Range("H6:K200").ClearContents
(I want to resize certain rows and columns,as the rows and columns are taking a lot of space which isn't required)
'Building the Annexure Section'
ThisWorkbook.Worksheets(cStrWSName).Range("H4").Value = "Annexure I"
ThisWorkbook.Worksheets(cStrWSName).Range("H4:K4").Merge
ThisWorkbook.Worksheets(cStrWSName).Range("H4:K4").HorizontalAlignment = xlCenter
ThisWorkbook.Worksheets(cStrWSName).Range("H4:K4").Font.Bold = True

ThisWorkbook.Worksheets(cStrWSName).Cells(5, 2).Copy Cells(5, 9)
ThisWorkbook.Worksheets(cStrWSName).Cells(5, 3).Copy Cells(5, 10)
ThisWorkbook.Worksheets(cStrWSName).Cells(5, 4).Copy Cells(5, 11)


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)
        ThisWorkbook.Worksheets(cStrWSName).Range("C10").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C10").Value + currentWkbk.Sheets(cStrWSName).Range("C10").Value
        ThisWorkbook.Worksheets(cStrWSName).Range("C11").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C11").Value + currentWkbk.Sheets(cStrWSName).Range("C11").Value
        ThisWorkbook.Worksheets(cStrWSName).Range("C13").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C13").Value + currentWkbk.Sheets(cStrWSName).Range("C13").Value
        ThisWorkbook.Worksheets(cStrWSName).Range("C14").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C14").Value + currentWkbk.Sheets(cStrWSName).Range("C14").Value


        ThisWorkbook.Worksheets(cStrWSName).Range("C16").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C16").Value + currentWkbk.Sheets(cStrWSName).Range("C16").Value

        ThisWorkbook.Worksheets(cStrWSName).Range("C20").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C20").Value + currentWkbk.Sheets(cStrWSName).Range("C20").Value

        ThisWorkbook.Worksheets(cStrWSName).Range("C23").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C23").Value + currentWkbk.Sheets(cStrWSName).Range("C23").Value
        ThisWorkbook.Worksheets(cStrWSName).Range("C24").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C24").Value + currentWkbk.Sheets(cStrWSName).Range("C24").Value
        ThisWorkbook.Worksheets(cStrWSName).Range("C25").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C25").Value + currentWkbk.Sheets(cStrWSName).Range("C25").Value

        ThisWorkbook.Worksheets(cStrWSName).Range("C40").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C40").Value + currentWkbk.Sheets(cStrWSName).Range("C40").Value
        ThisWorkbook.Worksheets(cStrWSName).Range("C41").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C41").Value + currentWkbk.Sheets(cStrWSName).Range("C41").Value
        ThisWorkbook.Worksheets(cStrWSName).Range("C42").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C42").Value + currentWkbk.Sheets(cStrWSName).Range("C42").Value
        ThisWorkbook.Worksheets(cStrWSName).Range("C43").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C43").Value + currentWkbk.Sheets(cStrWSName).Range("C43").Value
        ThisWorkbook.Worksheets(cStrWSName).Range("C44").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C44").Value + currentWkbk.Sheets(cStrWSName).Range("C44").Value
        ThisWorkbook.Worksheets(cStrWSName).Range("C45").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C45").Value + currentWkbk.Sheets(cStrWSName).Range("C45").Value
        ThisWorkbook.Worksheets(cStrWSName).Range("C46").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C46").Value + currentWkbk.Sheets(cStrWSName).Range("C46").Value
        ThisWorkbook.Worksheets(cStrWSName).Range("C47").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C47").Value + currentWkbk.Sheets(cStrWSName).Range("C47").Value

        ThisWorkbook.Worksheets(cStrWSName).Range("C52").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C52").Value + currentWkbk.Sheets(cStrWSName).Range("C52").Value
        ThisWorkbook.Worksheets(cStrWSName).Range("C53").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C53").Value + currentWkbk.Sheets(cStrWSName).Range("C53").Value
        ThisWorkbook.Worksheets(cStrWSName).Range("C54").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C54").Value + currentWkbk.Sheets(cStrWSName).Range("C54").Value

        ThisWorkbook.Worksheets(cStrWSName).Range("C56").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C56").Value + currentWkbk.Sheets(cStrWSName).Range("C56").Value
        ThisWorkbook.Worksheets(cStrWSName).Range("C57").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C57").Value + currentWkbk.Sheets(cStrWSName).Range("C57").Value
        ThisWorkbook.Worksheets(cStrWSName).Range("C58").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C58").Value + currentWkbk.Sheets(cStrWSName).Range("C58").Value
        ThisWorkbook.Worksheets(cStrWSName).Range("C59").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C59").Value + currentWkbk.Sheets(cStrWSName).Range("C59").Value

        ThisWorkbook.Worksheets(cStrWSName).Range("C66").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C66").Value + currentWkbk.Sheets(cStrWSName).Range("C66").Value

        ThisWorkbook.Worksheets(cStrWSName).Range("C68").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C68").Value + currentWkbk.Sheets(cStrWSName).Range("C68").Value

        ThisWorkbook.Worksheets(cStrWSName).Range("C71").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C71").Value + currentWkbk.Sheets(cStrWSName).Range("C71").Value
        ThisWorkbook.Worksheets(cStrWSName).Range("C72").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C72").Value + currentWkbk.Sheets(cStrWSName).Range("C72").Value
        ThisWorkbook.Worksheets(cStrWSName).Range("C73").Value = ThisWorkbook.Worksheets(cStrWSName).Range("C73").Value + currentWkbk.Sheets(cStrWSName).Range("C73").Value



        'Adding the Prudential/ Industrial Exposures to the annexure'

        rowNum = Range("I65536").End(xlUp).Row


        ThisWorkbook.Worksheets(cStrWSName).Cells(rowNum + 1, 8).Value = Left(currentWkbk.Name, Len(currentWkbk.Name) - 4)
        ThisWorkbook.Worksheets(cStrWSName).Cells(rowNum + 1, 8).Font.Bold = True
        currentWkbk.Sheets(cStrWSName).Range("B29:D38").Copy
        ThisWorkbook.Worksheets(cStrWSName).Range(Cells(rowNum + 2, 9), Cells(rowNum + 11, 11)).PasteSpecial xlPasteValues
        ThisWorkbook.Worksheets(cStrWSName).Range(Cells(rowNum + 2, 9), Cells(rowNum + 11, 11)).PasteSpecial xlPasteFormats
        currentWkbk.Sheets(cStrWSName).Range("B76:D79").Copy
        ThisWorkbook.Worksheets(cStrWSName).Range(Cells(rowNum + 12, 9), Cells(rowNum + 15, 11)).PasteSpecial xlPasteValues
        ThisWorkbook.Worksheets(cStrWSName).Range(Cells(rowNum + 12, 9), Cells(rowNum + 15, 11)).PasteSpecial xlPasteFormats



        currentWkbk.Close
    End If
    fileName = Dir
    Loop
ProgramExit:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExit
End Sub

1 个答案:

答案 0 :(得分:0)

注释掉错误处理程序并检查哪一行失败。

仅供参考,.xlsx不允许任何代码(除非您的代码在外面运行)。

根据您的错误消息,您最终使用的PasteSpecial方法有问题。尝试手动复制。

顺便说一下,您的代码应该重构。

相关问题