vba复制数据并将数据从一个电子表格重新排列到另一个电子表格

问题描述：

我不熟悉此论坛，并需要一些帮助从预算电子表格获取信息到工作簿。我从中拉出的电子表格数据分散在多个列和行中，并且存在许多空白单元格，但我需要在工作簿中以行项目格式排列并且没有空白。我可以手动链接每个表格中的每个单元格和行，但它需要很多代码，并不是很优雅。我认为我最好的选择是在列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列该行。此外，由于预算表分成不同的部分，我应该为每个部分重写相同的代码，将我更改为新的范围？

你已经有足够体面的代码，但很难准确地告诉你想要做什么。我会说绝对不需要“为每个部分重写相同的代码”，但是对于任何人提供更多指导，有助于更好地理解输入/输出以及“部分”的含义（即，描述这是如何工作的一个部分，以及如何不适用于其他部分（S）？） –

谢谢。不幸的是，我正在处理一些非常敏感的信息，否则我会发布源代码表。我的意思是说，预算表分为多种费用类型，每种费用类型都有自己的一套数据，甚至每个部分的组织方式也不同。原始代码为一个部分工作的原因是，其中的数据是固定的，并且始终填充，但是，其他部分需要更多的细节，并不总是得到填充...... –

对数据进行清理，然后用虚拟工具数据。实际的数据并不重要，但对于那些试图帮助您很好地理解您的工作内容以及您想要完成什么的人来说，这一点非常重要。并且，请将您的澄清评论添加到问题本身（[通过编辑]（http://*.com/posts/38961626/edit））而不是评论： –

答

这将通过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

是的！这让我更接近我想要完成的事情。我需要修改一些特定的需求，但非常感谢您分享此！稍后将更新上面的代码，当我得到这个工作！ –

如果您遇到任何其他问题，请告知我，我很乐意帮助您解决问题。如果您觉得这个问题已经足够回答，请标记为已回答。 – Kyle

答

如果你只是想如果有不被复制的公式或其他任何跳过空白行，那么像这样

Set sourceRange = sourceSheet.UsedRange.SpecialCells(xlCellTypeConstants) 

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

sourceRange.Copy 

targetSheet.Paste

，让我知道。

vba复制数据并将数据从一个电子表格重新排列到另一个电子表格

相关推荐