Fatal编程技术网
  • vba/
  • vba复制数据并将数据从一个电子表格重新排列到另一个电子表格

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

vba excel

vba复制数据并将数据从一个电子表格重新排列到另一个电子表格,vba,excel,Vba,Excel,我是这个论坛的新手，在从预算电子表格到工作簿获取信息方面需要一些帮助。我从中提取的电子表格的数据分布在多个列和行中，并且有许多空白单元格，但我需要在工作簿中以行项目格式排列，没有空白。 我可以手动链接每张工作表中的每个单元格和行，但它需要大量代码，而且不是很优雅。 我认为我最好的选择是通过B列运行一个循环，如果B列中有一个值，那么将该行中有一个值的所有单元格复制到新的工作表中 这是我目前掌握的代码： Private Sub ImportBudget_Click() Dim BudgetBook

我是这个论坛的新手，在从预算电子表格到工作簿获取信息方面需要一些帮助。我从中提取的电子表格的数据分布在多个列和行中，并且有许多空白单元格，但我需要在工作簿中以行项目格式排列，没有空白。 我可以手动链接每张工作表中的每个单元格和行，但它需要大量代码，而且不是很优雅。 我认为我最好的选择是通过B列运行一个循环，如果B列中有一个值，那么将该行中有一个值的所有单元格复制到新的工作表中

这是我目前掌握的代码：

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

Private子导入预算点击（）
将预算书设置为工作簿
将筛选器设置为字符串
将标题设置为字符串
Dim BudgetFileName作为字符串
将ActiveBook设置为工作簿
将targetWorkbook设置为工作簿
设置targetWorkbook=Application.ActiveWorkbook
'获取预算工作簿
filter=“Excel文件（*.xlsx），*.xlsx”
caption=“请选择一个输入文件”
BudgetFileName=Application.GetOpenFilename（过滤器，标题）
设置BudgetBook=Application.Workbooks.Open（BudgetFileName）
'将数据从预算复制到目标工作簿
将目标工作表变暗为工作表
设置targetSheet=targetWorkbook.Worksheets（1）
将源表设置为工作表
设置sourceSheet=BudgetBook.Worksheets（1）
作为整数的Dim i
作为整数的Dim j
j=2
对于i=2到300
如果sourceSheet.Cells（i，2）.Value“”和sourceSheet.Cells（i，1）”，则
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
如果结束
接下来我
预算书，关上
端接头
问题是，它只适用于原始电子表格的一个部分，但是，某些区域的行中最多有9列数据。此外，由于预算表被分为不同的部分，我是否应该为每个部分重写相同的代码，将I更改为新的范围？

这将循环通过
源表
和在列a或B（1或2）中有值的2和300之间的任何行它将在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

选项显式
私有子导入预算（单击）（）
将预算书设置为工作簿
将筛选器设置为字符串
将标题设置为字符串
Dim BudgetFileName作为字符串
将ActiveBook设置为工作簿
将targetWorkbook设置为工作簿
Dim i为单色，k为单色，计数器为单色
设置targetWorkbook=Application.ActiveWorkbook
'获取预算工作簿
filter=“Excel文件（*.xlsx），*.xlsx”
caption=“请选择一个输入文件”
BudgetFileName=Application.GetOpenFilename（过滤器，标题）
设置BudgetBook=Application.Workbooks.Open（BudgetFileName）
'将数据从预算复制到目标工作簿
将目标工作表变暗为工作表
设置targetSheet=targetWorkbook.Worksheets（1）
将源表设置为工作表
设置sourceSheet=BudgetBook.Worksheets（1）
j=2
使用源代码表
对于i=2到300
如果.Cells（i，2）.Value“”和.Cells（i，1）”，则
计数器=1
对于k=1到.Cells（i，.Columns.Count）.End（xlToLeft）.Column
如果.Cells（i，k）“，则
目标表单元格（j，计数器）=单元格（i，k）
计数器=计数器+1
如果结束
下一个k
j=j+1
如果结束
接下来我
以
预算书，关上
端接头
这将循环通过
源代码表
和在列a或B（1或2）中有值的2和300之间的任何行，并循环通过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

选项显式
私有子导入预算（单击）（）
将预算书设置为工作簿
将筛选器设置为字符串
将标题设置为字符串
Dim BudgetFileName作为字符串
将ActiveBook设置为工作簿
将targetWorkbook设置为工作簿
Dim i为单色，k为单色，计数器为单色
设置targetWorkbook=Application.ActiveWorkbook
'获取预算工作簿
filter=“Excel文件（*.xlsx），*.xlsx”
caption=“请选择一个输入文件”
BudgetFileName=Application.GetOpenFilename（过滤器，标题）
设置BudgetBook=Application.Workbooks.Open（BudgetFileName）
'将数据从预算复制到目标工作簿
将目标工作表变暗为工作表
设置targetSheet=targetWorkbook.Worksheets（1）
将源表设置为工作表
设置sourceSheet=BudgetBook.Worksheets（1）
j=2
使用源代码表
对于i=2到300
如果.Cells（i，2）.Value“”和.Cells（i，1）”，则
计数器=1
对于k=1到.Cells（i，.Columns.Count）.End（xlToLeft）.Column
如果.Cells（i，k）“，则
目标表单元格（j，计数器）=单元格（i，k）
计数器=计数器+1
如果结束
下一个k
j=j+1
如果结束
接下来我
以
预算书，关上
端接头

< /代码> 如果您只想跳过空白行，那么类似这样的


Set sourceRange = sourceSheet.UsedRange.SpecialCells(xlCellTypeConstants)

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

sourceRange.Copy

targetSheet.Paste



如果你有公式或其他没有复制的东西，请告诉我

Set sourceRange = sourceSheet.UsedRange.SpecialCells(xlCellTypeConstants)

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

sourceRange.Copy

targetSheet.Paste



如果你有公式或其他没有复制的东西，请告诉我
 您已经有了足够好的代码，但很难确切地说出您要做什么。我想说，绝对没有必要“为每个部分重写相同的代码”，但对于任何提供更多指导的人来说，更好地了解输入/输出以及“部分”的含义将是很有帮助的（即，描述一个部分如何工作，其他部分如何不工作）？谢谢。不幸的是，我正在处理一些相当敏感的信息，否则我会发布她所说的消息来源