Question

在VBA Excel中需要一些帮助编码。所以目前，我有100多个表，必须从每个区域的许多单独的Excel文件手动输入每个表的所有数据。您可以在此处查看表格图片：https://i.stack.imgur.com/ftLdE.png

我目前的代码仍然依赖于定位要复制的单元格范围，考虑到行/列是否有变化，这是不可行的。

无论如何要集中从每个地区的Excel文件中获取所有数据并插入吗？

或者是否可以定位标题或表名，以便它可以自动填写？请原谅我，如果解决方案如此简单并且之前已被问过。

非常感谢您的帮助。

Sub Extract()
Dim x As Workbook
Dim y As Workbook
Dim OpenSource As String
Dim OpenTarget As String
OpenSource = Application.GetOpenFilename("File Type, *.xlsm")
If OpenSource = "False" Then Exit Sub
OpenTarget = Application.GetOpenFilename("File Type, *.xlsm")
If OpenTarget = "False" Then Exit Sub
'## Open both workbooks first:

Set x = Workbooks.Open(OpenSource) 'Source File 'thisworkbook can implement here?
Set y = Workbooks.Open(OpenTarget) 'Destination File

'Now, transfer values from x to y:
y.Sheets("Data").Range("C16:N16").Value = x.Sheets("Data").Range("C19:N19").Value
y.Sheets("Data").Range("C34:N34").Value = x.Sheets("Data").Range("C37:N37").Value
y.Sheets("Data").Range("C52:N52").Value = x.Sheets("Data").Range("C55:N55").Value
y.Sheets("Data").Range("C70:N70").Value = x.Sheets("Data").Range("C73:N73").Value
y.Sheets("Data").Range("C124:N124").Value = x.Sheets("Data").Range("C127:N127").Value
y.Sheets("Data").Range("C286:N286").Value = x.Sheets("Data").Range("C289:N289").Value

y.Sheets("Data").Range("R88:AC88").Value = x.Sheets("Data").Range("R91:AC91").Value
y.Sheets("Data").Range("R106:AC106").Value = x.Sheets("Data").Range("R109:AC109").Value
y.Sheets("Data").Range("R142:AC142").Value = x.Sheets("Data").Range("R145:AC145").Value
y.Sheets("Data").Range("R160:AC160").Value = x.Sheets("Data").Range("R163:AC163").Value
y.Sheets("Data").Range("R178:AC178").Value = x.Sheets("Data").Range("R181:AC181").Value
y.Sheets("Data").Range("R196:AC196").Value = x.Sheets("Data").Range("R199:AC199").Value
y.Sheets("Data").Range("R214:AC214").Value = x.Sheets("Data").Range("R217:AC217").Value
y.Sheets("Data").Range("R232:AC232").Value = x.Sheets("Data").Range("R235:AC235").Value
y.Sheets("Data").Range("R250:AC250").Value = x.Sheets("Data").Range("R253:AC253").Value
y.Sheets("Data").Range("R268:AC268").Value = x.Sheets("Data").Range("R271:AC271").Value

y.Sheets("Data").Range("AG88:AR88").Value = x.Sheets("Data").Range("AG91:AR91").Value
y.Sheets("Data").Range("AG106:AR106").Value = x.Sheets("Data").Range("A109:AR109").Value
y.Sheets("Data").Range("AG142:AR142").Value = x.Sheets("Data").Range("AG145:AR145").Value
y.Sheets("Data").Range("AG160:AR160").Value = x.Sheets("Data").Range("AG163:AR163").Value
y.Sheets("Data").Range("AG178:AR178").Value = x.Sheets("Data").Range("AG181:AR181").Value
y.Sheets("Data").Range("AG196:AR196").Value = x.Sheets("Data").Range("AG199:AR199").Value
y.Sheets("Data").Range("AG214:AR214").Value = x.Sheets("Data").Range("AG217:AR217").Value
y.Sheets("Data").Range("AG232:AR232").Value = x.Sheets("Data").Range("AG235:AR235").Value
y.Sheets("Data").Range("AG250:AR250").Value = x.Sheets("Data").Range("AG253:AR253").Value
y.Sheets("Data").Range("AG268:AR268").Value = x.Sheets("Data").Range("AG271:AR271").Value


MsgBox ("Done")
End Sub

Answer 1

不确定。只要您知道起点，就可以动态计算和复制行，请参阅以下代码的修改：

angular.module('extApp').value('myValue', {
  foo: null,
  bar: null
});

angular.module('extApp')
.directive('myDirective', ['constants', 'myValue', function(constants, myValue) {
  return {
    restrict: 'E',
    template: '<div></div>',
    scope: {
      location: '=',
      connectionType: '='
    },
    controller: function($scope) {
      ...
    },
    link: function(scope, element, attr) {
      scope.myFunction = function() {
        // Want to be able to reference my myValue here! For example:
        if (myValue.foo != null && myValue.foo > 0) {
            // myValue.foo doesn't work because it sees myValue as undefined
        }
      }

      scope.myOtherFunction = function() {
        ...
      }

      scope.myFunction();
    }
  }
}]);

我放x.Sheets("Data").Range("C16:N" & Cells(Rows.Count, 14).End(xlUp).Row).Copy Destination:=y.Sheets("Data").Range("C19")，14与N列相关。

对其余的应用相同的逻辑，你应该没事！让我知道这是如何工作的，因为我还没有测试过它：）

Answer 2

我认为我们的目的地和来源也是错误的。如何反向放置代码？例如。源应该来自源文件的行C19：N19，并且要复制到目标文件的行C14：N14。

Sub Extract()
Dim x As Workbook
Dim y As Workbook
Dim OpenSource As String
Dim OpenTarget As String
OpenSource = Application.GetOpenFilename("File Type, *.xlsm")
If OpenSource = "False" Then Exit Sub
OpenTarget = Application.GetOpenFilename("File Type, *.xlsm")
If OpenTarget = "False" Then Exit Sub


Set x = Workbooks.Open(OpenSource) 'Source File
Set y = Workbooks.Open(OpenTarget) 'Destination File

x.Sheets("Data").Range("C14:N" & Cells(Rows.Count, 14).End(xlUp).Row).Copy Destination:=y.Sheets("Data").Range("C19")

MsgBox ("Done")
End Sub

Excel VBA从各种工作簿中的各种单元格进行复制

2 个答案: