将从客户端接收Excel文件中不同格式的数据。
通常，文件会有三张以上的图纸，每张图纸中都有多列。我需要特别的专栏。我想将所需的列复制到分析文件的特定工作表中。
我的代码以交互方式显示一个用户表单，用户在其中提供图纸和列号，VBA将从中获取数据并捕获用户表单数据以供分析文件中参考。
如果用户选择了5-6列以上的列，则很难复制到同一工作表中的另一个文件，有时需要调整同一列；动态粘贴到现有数据下方。据我所知，我不能只复制所选列中的数据。它在粘贴时复制整列，并且不允许在现有列中动态粘贴。
用户表单：
Option Explicit
Private Sub CommandButton1_Click()
Dim myColumn As Integer
Dim eRow
Dim mySheet As Integer
Dim mySheet2 As Integer
Dim myColumn2 As Integer
Dim eRow2
mySheet = Val(TextBox2.Text)
Sheets(mySheet).Select
myColumn = Val(TextBox1.Text)
Columns(myColumn).Copy
ThisWorkbook.Worksheets("Sheet2").Range("A1").PasteSpecial xlPasteValues
eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(eRow, 1) = TextBox1.Text
mySheet2 = Val(TextBox8.Text)
Sheets(mySheet2).Select
myColumn2 = Val(TextBox6.Text)
Columns(myColumn2).Copy
ThisWorkbook.Worksheets("Sheet2").Range("B1").PasteSpecial xlPasteValues
eRow2 = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(eRow2, 1) = TextBox6.Text
ThisWorkbook.Worksheets("Sheet2").Range("E4").Value = mySheet
MsgBox ("Client data has been successfully added,vbOKOnly")
End Sub
模块代码：
Option Explicit
Public Sub Main()
Dim myUserForm As UserForm1
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim xRg As Range
Dim rng As Range
FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
Set myUserForm = New UserForm1
myUserForm.Show
End If
End Sub
您可以从特定范围复制数据，而不是从整列复制数据。你只需要更改你的列(myColumn(。复制类似于范围(myRange(的内容。复制.
如果从某个区域获取数据，请确保粘贴数据的列不包含任何旧数据。因为它只会覆盖您复制的范围中的数据，该范围可能小于目标范围。
如果要动态选择目的地。你可以使用这样的东西：Range(myRange).end(xldown).offset(1,0).paste xlvalues
这个想法是"；结束"；将找到其上有数据的最后一行；偏移"；会给它下面的牢房，那就是你的目的地。
以下是这些属性的文档链接：
https://learn.microsoft.com/en-us/office/vba/api/excel.range.end
https://learn.microsoft.com/en-us/office/vba/api/excel.range.offset
也许您想升级到数据库。下面的代码将通过TransferSpreadsheet(VBA(将单个文件夹中所有EXCEL文件中的所有工作表中的数据导入到单独的表格中。。。
Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim intWorkbookCounter As Integer
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPath As String, strFile As String
Dim strPassword As String
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0
' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = False
' Replace C:MyFolder with the actual path to the folder that holds the EXCEL files
strPath = "C:MyFolder"
' Replace passwordtext with the real password;
' if there is no password, replace it with vbNullString constant
' (e.g., strPassword = vbNullString)
strPassword = "passwordtext"
blnReadOnly = True ' open EXCEL file in read-only mode
strFile = Dir(strPath & "*.xls")
intWorkbookCounter = 0
Do While strFile <> ""
intWorkbookCounter = intWorkbookCounter + 1
Set colWorksheets = New Collection
Set objWorkbook = objExcel.Workbooks.Open(strPath & strFile, , _
blnReadOnly, , strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
Next lngCount
' Close the EXCEL file without saving the file, and clean up the EXCEL objects
objWorkbook.Close False
Set objWorkbook = Nothing
' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"tbl" & colWorksheets(lngCount) & intWorkbookCounter, _
strPath & strFile, blnHasFieldNames, _
colWorksheets(lngCount) & "$"
Next lngCount
' Delete the collection
Set colWorksheets = Nothing
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPath & strFile
strFile = Dir()
Loop
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing
参考URL如下：
http://www.accessmvp.com/KDSnell/EXCEL_Import.htm#ImpAllWkshts