Excel VBA爲輸入框選擇表格來形成

我有一個代碼在下面，需要調整，因爲我想能夠在輸入框中輸入我的工作表名稱，並重新格式化工作表和旁邊的輸出我選擇的工作表。Excel VBA爲輸入框選擇表格來形成

看到公式我嘗試但失敗。

Sub Chart() 
    Dim wb As Workbook 
    Dim wsRaw As Worksheet, wsResult As Worksheet 
    Dim iRow As Byte, iCol As Byte, iResultRow As Byte, iRawCol As Byte 
    Dim Result As String 

Result = InputBox("Provide a sheet name.") 
Workbooks(wb).Sheets(Result).Select 
Set wb = ThisWorkbook 
    Set wsRaw = Application.ActiveSheet 
    Set wsResult = Worksheets.Add(After:=Sheets(Worksheets.count)) 
    iRow = 2 

iResultRow = 2 

    Do Until wsRaw.Cells(iRow, 1) = Empty 

    wsResult.Cells(iResultRow, 1) = wsRaw.Cells(iRow, 1) 
    wsResult.Cells(iResultRow + 1, 1) = wsRaw.Cells(iRow, 1) 
    wsResult.Cells(iResultRow + 2, 1) = wsRaw.Cells(iRow, 1) 

    wsResult.Cells(iResultRow, 2) = wsRaw.Cells(iRow, 2) 
    wsResult.Cells(iResultRow + 1, 2) = wsRaw.Cells(iRow, 2) 
    wsResult.Cells(iResultRow + 2, 2) = wsRaw.Cells(iRow, 2) 

    wsResult.Cells(iResultRow, 3) = wsRaw.Cells(iRow, 3) 
    wsResult.Cells(iResultRow + 1, 3) = wsRaw.Cells(iRow, 3) 
    wsResult.Cells(iResultRow + 2, 3) = wsRaw.Cells(iRow, 3) 

    wsResult.Cells(iResultRow, 4) = wsRaw.Cells(iRow, 4) 
    wsResult.Cells(iResultRow + 1, 4) = wsRaw.Cells(iRow, 4) 
    wsResult.Cells(iResultRow + 2, 4) = wsRaw.Cells(iRow, 4) 

    wsResult.Cells(iResultRow, 5) = "Lender" 
    wsResult.Cells(iResultRow + 1, 5) = "All" 
    wsResult.Cells(iResultRow + 2, 5) = "Percent" 

    iRawCol = 5 
    iCol = 6 
    Do Until iCol = 46 
    wsResult.Cells(1, iCol) = Left(wsRaw.Cells(1, iRawCol), 9) 
    wsResult.Cells(iResultRow, iCol) = wsRaw.Cells(iRow, iRawCol) 
    wsResult.Cells(iResultRow + 1, iCol) = wsRaw.Cells(iRow, iRawCol + 1) 
    wsResult.Cells(iResultRow + 2, iCol) = wsRaw.Cells(iRow, iRawCol + 2) 
    iCol = iCol + 1 
    iRawCol = iRawCol + 3 
    Loop 
iResultRow = iResultRow + 3 
iRow = iRow + 1 
    Loop 

    Sheets("Macros").Select 
    End Sub

來源

2017-03-14 won_g

Sub Chart() 
Dim wb As Workbook 
Dim wsRaw As Worksheet, wsResult As Worksheet 
Dim iRow As Byte, iCol As Byte, iResultRow As Byte, iRawCol As Byte 
Dim Result As Worksheet, RangeResult As Range 
Set wb = ThisWorkbook 
Set ResultRange = Application.InputBox("Provide a sheet name.", Type:=8) 
Set Result = ResultRange.Parent 
wb.Result.Select 

Set wsRaw = Application.ActiveSheet 
Set wsResult = Worksheets.Add(After:=Sheets(Worksheets.Count)) 
iRow = 2 

iResultRow = 2 

Do Until wsRaw.Cells(iRow, 1) = Empty 

wsResult.Cells(iResultRow, 1) = wsRaw.Cells(iRow, 1) 
wsResult.Cells(iResultRow + 1, 1) = wsRaw.Cells(iRow, 1) 
wsResult.Cells(iResultRow + 2, 1) = wsRaw.Cells(iRow, 1) 

wsResult.Cells(iResultRow, 2) = wsRaw.Cells(iRow, 2) 
wsResult.Cells(iResultRow + 1, 2) = wsRaw.Cells(iRow, 2) 
wsResult.Cells(iResultRow + 2, 2) = wsRaw.Cells(iRow, 2) 

wsResult.Cells(iResultRow, 3) = wsRaw.Cells(iRow, 3) 
wsResult.Cells(iResultRow + 1, 3) = wsRaw.Cells(iRow, 3) 
wsResult.Cells(iResultRow + 2, 3) = wsRaw.Cells(iRow, 3) 

wsResult.Cells(iResultRow, 4) = wsRaw.Cells(iRow, 4) 
wsResult.Cells(iResultRow + 1, 4) = wsRaw.Cells(iRow, 4) 
wsResult.Cells(iResultRow + 2, 4) = wsRaw.Cells(iRow, 4) 

wsResult.Cells(iResultRow, 5) = "Lender" 
wsResult.Cells(iResultRow + 1, 5) = "All" 
wsResult.Cells(iResultRow + 2, 5) = "Percent" 

iRawCol = 5 
iCol = 6 
Do Until iCol = 46 
wsResult.Cells(1, iCol) = Left(wsRaw.Cells(1, iRawCol), 9) 
wsResult.Cells(iResultRow, iCol) = wsRaw.Cells(iRow, iRawCol) 
wsResult.Cells(iResultRow + 1, iCol) = wsRaw.Cells(iRow, iRawCol + 1) 
wsResult.Cells(iResultRow + 2, iCol) = wsRaw.Cells(iRow, iRawCol + 2) 
iCol = iCol + 1 
iRawCol = iRawCol + 3 
Loop 
iResultRow = iResultRow + 3 
iRow = iRow + 1 
Loop 

Sheets("Macros").Select 
End Sub

來源

2017-03-14 00:08:15 dbodell

遺憾，你可以把它在上下文中的VBA代碼。我仍然在學習它，可能已經打破了我的代碼更多。感謝 –

好吧檢查我的ediit。 – dbodell

Set ResultRange = InputBox（「提供工作表名稱」，類型：= 8）語句返回調試消息「編譯錯誤：找不到名稱的參數」 –

Excel VBA爲輸入框選擇表格來形成

回答

相關問題