2016-08-15 183 views
0

我不熟悉此論壇,並需要一些幫助從預算電子表格獲取信息到工作簿。我從中拉出的電子表格數據分散在多個列和行中,並且存在許多空白單元格,但我需要在工作簿中以行項目格式排列並且沒有空白。 我可以手動鏈接每個表格中的每個單元格和行,但它需要很多代碼,並不是很優雅。 我認爲我最好的選擇是在列B中運行一個循環,如果那裏有一個值,那麼將所有單元格的行中的值複製到新表格中。vba複製數據並將數據從一個電子表格重新排列到另一個電子表格

這是我的代碼至今:

Private Sub ImportBudget_Click() 
Dim BudgetBook As Workbook 
Dim filter As String 
Dim caption As String 
Dim BudgetFileName As String 
Dim ActiveBook As Workbook 
Dim targetWorkbook As Workbook 

Set targetWorkbook = Application.ActiveWorkbook 

' get the budget workbook 
filter = "Excel files (*.xlsx),*.xlsx" 
caption = "Please Select an input file " 
BudgetFileName = Application.GetOpenFilename(filter, , caption) 

Set BudgetBook = Application.Workbooks.Open(BudgetFileName) 

' copy data from budget to target workbook 
Dim targetSheet As Worksheet 
Set targetSheet = targetWorkbook.Worksheets(1) 
Dim sourceSheet As Worksheet 
Set sourceSheet = BudgetBook.Worksheets(1) 
Dim i As Integer 
Dim j As Integer 
    j = 2 
    For i = 2 To 300 
    If sourceSheet.Cells(i, 2).Value <> "" And sourceSheet.Cells(i, 1) <> "" Then 
    targetSheet.Cells(j, 1).Value = sourceSheet.Cells(i, 1).Value 
    targetSheet.Cells(j, 2).Value = sourceSheet.Cells(i, 2).Value 
    targetSheet.Cells(j, 3).Value = sourceSheet.Cells(i, 3).Value 
    j = j + 1 

    End If 
    Next i 

BudgetBook.Close 
End Sub 

這裏的問題是,它非常適用於只是一個原始的電子表格的部分,但是,局部地區有數據高達9列該行。此外,由於預算表分成不同的部分,我應該爲每個部分重寫相同的代碼,將我更改爲新的範圍?

+1

你已經有足夠體面的代碼,但很難準確地告訴你想要做什麼。我會說絕對不需要「爲每個部分重寫相同的代碼」,但是對於任何人提供更多指導,有助於更好地理解輸入/輸出以及「部分」的含義(即,描述這是如何工作的一個部分,以及如何不適用於其他部分(S)?) –

+0

謝謝。不幸的是,我正在處理一些非常敏感的信息,否則我會發布源代碼表。我的意思是說,預算表分爲多種費用類型,每種費用類型都有自己的一套數據,甚至每個部分的組織方式也不同。原始代碼爲一個部分工作的原因是,其中的數據是固定的,並且始終填充,但是,其他部分需要更多的細節,並不總是得到填充...... –

+0

對數據進行清理,然後用虛擬工具數據。實際的數據並不重要,但對於那些試圖幫助您很好地理解您的工作內容以及您想要完成什麼的人來說,這一點非常重要。並且,請將您的澄清評論添加到問題本身([通過編輯](http://stackoverflow.com/posts/38961626/edit))而不是評論: –

回答

1

這將通過sourceSheet以及2到300之間的任何行在A或B列(1或2)中具有一個值,它將採用循環遍歷1到最後一列之間的數據。然後,該列範圍內的所有非空白單元格以及該行中的所有非空白單元格將被置於targetSheet的新行中,而列中的數據之間沒有空格。

Option Explicit 
Private Sub ImportBudget_Click() 
Dim BudgetBook As Workbook 
Dim filter As String 
Dim caption As String 
Dim BudgetFileName As String 
Dim ActiveBook As Workbook 
Dim targetWorkbook As Workbook 
Dim i as Single, k as Single, counter as Single 

Set targetWorkbook = Application.ActiveWorkbook 

' get the budget workbook 
filter = "Excel files (*.xlsx),*.xlsx" 
caption = "Please Select an input file " 
BudgetFileName = Application.GetOpenFilename(filter, , caption) 

Set BudgetBook = Application.Workbooks.Open(BudgetFileName) 

' copy data from budget to target workbook 
Dim targetSheet As Worksheet 
Set targetSheet = targetWorkbook.Worksheets(1) 
Dim sourceSheet As Worksheet 
Set sourceSheet = BudgetBook.Worksheets(1) 

j = 2 

With sourceSheet 
    For i = 2 To 300 
    If .Cells(i, 2).Value <> "" And .Cells(i, 1) <> "" Then 

     counter = 1 

     For k = 1 to .Cells(i,.Columns.Count).End(xlToLeft).Column 
      If .Cells(i,k) <> "" Then 
      targetSheet.Cells(j,counter) = .Cells(i,k) 
      counter = counter + 1 
      End if 
     Next k 
    j = j + 1 

    End If 
    Next i 
End With 

BudgetBook.Close 
End Sub 
+0

是的!這讓我更接近我想要完成的事情。我需要修改一些特定的需求,但非常感謝您分享此!稍後將更新上面的代碼,當我得到這個工作! –

+0

如果您遇到任何其他問題,請告知我,我很樂意幫助您解決問題。如果您覺得這個問題已經足夠回答,請標記爲已回答。 – Kyle

1

如果你只是想如果有不被複制的公式或其他任何跳過空白行,那麼像這樣

Set sourceRange = sourceSheet.UsedRange.SpecialCells(xlCellTypeConstants) 

Set sourceRange = Intersect(sourceRange.EntireRow, sourceRange.EntireColumn) 

sourceRange.Copy 

targetSheet.Paste 

,讓我知道。

相關問題