我在尝试将数据从一个工作表复制到另一个工作表时遇到问题。
我有组合框，其中包含我的工作表标题中的列表。然后，我使用工作表标题s根据组合框值确定要复制到新工作表的列。它在编辑表单时有效但只要我保存，关闭并打开它就会抱怨“对象变量或未设置块变量”
Public Sub ExportButton_Click()
If FileNameTxt.Value = "" Then
MsgBox "Please choose a file name"
WinOSBtn.Value = False
ExportButton.Locked = True
ExportButton.BackColor = RGB(250, 250, 250)
ExportButton.ForeColor = RGB(220, 220, 220)
FileNameTxt.SetFocus
Else
ExportButton.Locked = False
ExportButton.BackColor = RGB(241, 241, 241)
ExportButton.ForeColor = RGB(0, 0, 0)
End If
Dim historyWks As Worksheet
Dim newWB As Workbook
Set historyWks = Worksheets("NameList")
'Create ranges for each ComboBox
Dim CBA As Range
Set CBA = Range("A1:AM1").Find(ComboBoxA.Value)
Dim CBB As Range
Set CBB = Range("A1:AM1").Find(ComboBoxB.Value)
Dim CBC As Range
Set CBC = Range("A1:AM1").Find(ComboBoxC.Value)
Dim CBD As Range
Set CBD = Range("A1:AM1").Find(ComboBoxD.Value)
Dim CBE As Range
Set CBE = Range("A1:AM1").Find(ComboBoxE.Value)
Dim CBF As Range
Set CBF = Range("A1:AM1").Find(ComboBoxF.Value)
Dim CBG As Range
Set CBG = Range("A1:AM1").Find(ComboBoxG.Value)
Dim CBH As Range
Set CBH = Range("A1:AM1").Find(ComboBoxH.Value)
Dim CBI As Range
Set CBI = Range("A1:AM1").Find(ComboBoxI.Value)
Dim CBJ As Range
Set CBJ = Range("A1:AM1").Find(ComboBoxJ.Value)
Dim CBK As Range
Set CBK = Range("A1:AM1").Find(ComboBoxK.Value)
Dim CBL As Range
Set CBL = Range("A1:AM1").Find(ComboBoxL.Value)
Dim CBM As Range
Set CBM = Range("A1:AM1").Find(ComboBoxM.Value)
Dim CBN As Range
Set CBN = Range("A1:AM1").Find(ComboBoxN.Value)
Dim CBO As Range
Set CBO = Range("A1:AM1").Find(ComboBoxO.Value)
Dim CBP As Range
Set CBP = Range("A1:AM1").Find(ComboBoxP.Value)
Dim CBQ As Range
Set CBQ = Range("A1:AM1").Find(ComboBoxQ.Value)
Dim CBR As Range
Set CBR = Range("A1:AM1").Find(ComboBoxR.Value)
Dim CBS As Range
Set CBS = Range("A1:AM1").Find(ComboBoxS.Value)
Dim CBT As Range
Set CBT = Range("A1:AM1").Find(ComboBoxT.Value)
Dim CBU As Range
Set CBU = Range("A1:AM1").Find(ComboBoxU.Value)
'Prompts for a file name
If FileNameTxt.Value = "" Then
MsgBox "Please choose a file name"
Else
'Add a new workbook with a file name
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=FileNameTxt.Value & ".xls"
'ActiveWorkbook.Close
Workbooks.Open (FileNameTxt.Value & ".xls")
Set newWB = Workbooks(FileNameTxt.Value & ".xls")
historyWks.Activate
With historyWks
If ComboBoxA <> "" Then
Range(CBA, CBA.End(xlDown)).Copy '***The error starts here and indecates that CBA=Nothing
'CBA.End(xlDown)=Object variable* or With block variable not set
newWB.Sheets("Sheet1").Range("A1").PasteSpecial xlPasteAll
newWB.Sheets("Sheet1").Range("A1").PasteSpecial xlPasteValues
End If
If ComboBoxB <> "" Then
Range(CBB, CBB.End(xlDown)).Copy
newWB.Sheets("Sheet1").Range("B1").PasteSpecial xlPasteAll
newWB.Sheets("Sheet1").Range("B1").PasteSpecial xlPasteValues
End If
If ComboBoxC <> "" Then
Range(CBC, CBC.End(xlDown)).Copy
newWB.Sheets("Sheet1").Range("C1").PasteSpecial xlPasteAll
newWB.Sheets("Sheet1").Range("C1").PasteSpecial xlPasteValues
End If
If ComboBoxD <> "" Then
Range(CBD, CBD.End(xlDown)).Copy
newWB.Sheets("Sheet1").Range("D1").PasteSpecial xlPasteAll
newWB.Sheets("Sheet1").Range("D1").PasteSpecial xlPasteValues
End If
If ComboBoxE <> "" Then
Range(CBE, CBE.End(xlDown)).Copy
newWB.Sheets("Sheet1").Range("E1").PasteSpecial xlPasteAll
newWB.Sheets("Sheet1").Range("E1").PasteSpecial xlPasteValues
End If
If ComboBoxF <> "" Then
Range(CBF, CBF.End(xlDown)).Copy
newWB.Sheets("Sheet1").Range("F1").PasteSpecial xlPasteAll
newWB.Sheets("Sheet1").Range("F1").PasteSpecial xlPasteValues
End If
If ComboBoxG <> "" Then
Range(CBG, CBG.End(xlDown)).Copy
newWB.Sheets("Sheet1").Range("G1").PasteSpecial xlPasteAll
newWB.Sheets("Sheet1").Range("G1").PasteSpecial xlPasteValues
End If
If ComboBoxH <> "" Then
Range(CBH, CBH.End(xlDown)).Copy
newWB.Sheets("Sheet1").Range("H1").PasteSpecial xlPasteAll
newWB.Sheets("Sheet1").Range("H1").PasteSpecial xlPasteValues
End If
If ComboBoxI <> "" Then
Range(CBI, CBI.End(xlDown)).Copy
newWB.Sheets("Sheet1").Range("I1").PasteSpecial xlPasteAll
newWB.Sheets("Sheet1").Range("I1").PasteSpecial xlPasteValues
End If
If ComboBoxJ <> "" Then
Range(CBJ, CBJ.End(xlDown)).Copy
newWB.Sheets("Sheet1").Range("J1").PasteSpecial xlPasteAll
newWB.Sheets("Sheet1").Range("J1").PasteSpecial xlPasteValues
End If
If ComboBoxK <> "" Then
Range(CBK, CBK.End(xlDown)).Copy
newWB.Sheets("Sheet1").Range("K1").PasteSpecial xlPasteAll
newWB.Sheets("Sheet1").Range("K1").PasteSpecial xlPasteValues
End If
If ComboBoxL <> "" Then
Range(CBL, CBL.End(xlDown)).Copy
newWB.Sheets("Sheet1").Range("L1").PasteSpecial xlPasteAll
newWB.Sheets("Sheet1").Range("L1").PasteSpecial xlPasteValues
End If
If ComboBoxM <> "" Then
Range(CBM, CBM.End(xlDown)).Copy
newWB.Sheets("Sheet1").Range("M1").PasteSpecial xlPasteAll
newWB.Sheets("Sheet1").Range("M1").PasteSpecial xlPasteValues
End If
If ComboBoxN <> "" Then
Range(CBN, CBN.End(xlDown)).Copy
newWB.Sheets("Sheet1").Range("N1").PasteSpecial xlPasteAll
newWB.Sheets("Sheet1").Range("N1").PasteSpecial xlPasteValues
End If
If ComboBoxO <> "" Then
Range(CBO, CBO.End(xlDown)).Copy
newWB.Sheets("Sheet1").Range("O1").PasteSpecial xlPasteAll
newWB.Sheets("Sheet1").Range("O1").PasteSpecial xlPasteValues
End If
If ComboBoxP <> "" Then
Range(CBP, CBP.End(xlDown)).Copy
newWB.Sheets("Sheet1").Range("P1").PasteSpecial xlPasteAll
newWB.Sheets("Sheet1").Range("P1").PasteSpecial xlPasteValues
End If
If ComboBoxQ <> "" Then
Range(CBQ, CBQ.End(xlDown)).Copy
newWB.Sheets("Sheet1").Range("Q1").PasteSpecial xlPasteAll
newWB.Sheets("Sheet1").Range("Q1").PasteSpecial xlPasteValues
End If
If ComboBoxR <> "" Then
Range(CBR, CBR.End(xlDown)).Copy
newWB.Sheets("Sheet1").Range("R1").PasteSpecial xlPasteAll
newWB.Sheets("Sheet1").Range("R1").PasteSpecial xlPasteValues
End If
If ComboBoxS <> "" Then
Range(CBS, CBS.End(xlDown)).Copy
newWB.Sheets("Sheet1").Range("S1").PasteSpecial xlPasteAll
newWB.Sheets("Sheet1").Range("S1").PasteSpecial xlPasteValues
End If
If ComboBoxT <> "" Then
Range(CBT, CBT.End(xlDown)).Copy
newWB.Sheets("Sheet1").Range("T1").PasteSpecial xlPasteAll
newWB.Sheets("Sheet1").Range("T1").PasteSpecial xlPasteValues
End If
If ComboBoxU <> "" Then
Range(CBU, CBU.End(xlDown)).Copy
newWB.Sheets("Sheet1").Range("U1").PasteSpecial xlPasteAll
newWB.Sheets("Sheet1").Range("U1").PasteSpecial xlPasteValues
End If
End With
End If
ExportForm.Hide
Dim i As Long
i = MsgBox("Export another?", vbOKCancel)
If i = vbOK Then
ExportForm.Show
If i = vbCancel Then Unload ExportForm
End If
End Sub
我一直在搜索论坛，但我仍然在苦苦挣扎。我确信有一种更聪明的方法来做所有这些，但我会到达那里。任何帮助解决错误的帮助都会非常棒！
答案 0 :(得分：1)
你定义CBA就像YourWorkbookName.sheets（yourSheetName）.Range（＆＃34; A1：AM1＆＃34;）。find（ComboBoxA.Value） 我认为这样运行没有错误。
答案 1 :(得分：1)
通过一些重构，您的代码可以更短（更强大）
Public Sub ExportButton_Click()
Dim historyWks As Worksheet
Dim newWB As Workbook, newSht As Worksheet, i As Long
Dim cb, f As Range
Set historyWks = Worksheets("NameList")
If FileNameTxt.Value = "" Then
MsgBox "Please choose a file name"
WinOSBtn.Value = False
ExportButton.Locked = True
ExportButton.BackColor = RGB(250, 250, 250)
ExportButton.ForeColor = RGB(220, 220, 220)
FileNameTxt.SetFocus
Exit Sub
Else
ExportButton.Locked = False
ExportButton.BackColor = RGB(241, 241, 241)
ExportButton.ForeColor = RGB(0, 0, 0)
End If
'Add a new workbook with a file name
Set newWB = Workbooks.Add()
newWB.SaveAs Filename:=FileNameTxt.Value & ".xls"
Set newSht = newWB.Sheets(1)
For i = 1 To 21
Set cb = Me.Controls("ComboBox" & Chr(64 + i))
If Len(cb.Value) > 0 Then
'always worth specifiying to check the complete value....
Set f = historyWks.Range("A1:AM1").Find(cb.Value, lookat:=xlWhole)
If Not f Is Nothing Then
'located the header - copy over
With historyWks
.Range(f, .Cells(.Rows.Count, f.Column).End(xlUp)).Copy
End With
With newSht.Cells(1, i)
.PasteSpecial xlPasteAll
.PasteSpecial xlPasteValues
End With
End If
End If
Next i
'rest of code here...
End Sub
答案 2 :(得分：1)
我使用Class在这里工作（不确定它真的是一个更好的解决方案），类Module的名称是“cFindComboValue”
cFindComboValue 类模块代码
Private myfRng As Range
Public ComboVal As Variant
Public Property Get fRng() As Range
Set fRng = myfRng
End Property
Public Property Set fRng(objRng As Range)
Set myfRng = objRng.Find(ComboVal, LookAt:=xlWhole)
End Property
您的其余代码与您的代码位于同一个Sub中。为了避免您遇到的错误，您需要捕获Find方法无法找到任何内容的可能性，因此添加行If not FindRng is Nothing可确保我们只复制成功的“查找”。 / p>
Option Explicit
Private Sub ExportButton_Click()
Dim newWB As Workbook
Dim historyWks As Worksheet
Dim PasteSht As Worksheet
Dim Ctl As Control
Dim FindRng As cFindComboValue
Dim Col As Long
' set FindRng as New cFindComboValue (Class)
Set FindRng = New cFindComboValue
Set historyWks = Worksheets("NameList")
' --- Haven't touched this section ---
If FileNameTxt.value = "" Then
MsgBox "Please choose a file name"
WinOSBtn.value = False
ExportButton.Locked = True
ExportButton.BackColor = RGB(250, 250, 250)
ExportButton.ForeColor = RGB(220, 220, 220)
FileNameTxt.SetFocus
Else
ExportButton.Locked = False
ExportButton.BackColor = RGB(241, 241, 241)
ExportButton.ForeColor = RGB(0, 0, 0)
End If
'Add a new workbook with a file name
Set newWB = Workbooks.Add()
newWB.SaveAs Filename:=FileNameTxt.value & ".xls"
Set PasteSht = newWB.Sheets("Sheet1") ' kept "Sheet1" as your destination Paste sheet
' reset Paste Column to "A"
Col = 1
' loop through all Controls in User Form
For Each Ctl In Me.Controls
If TypeOf Ctl Is ComboBox Then ' check if current control is ComboBox
If Ctl.value <> "" Then
' pass the ComboBox value to the Class
FindRng.ComboVal = Ctl.value
' set the FindRange property of the class
Set FindRng.fRng = historyWks.Range("A1:AM1")
' Find method was Successful
If Not FindRng.fRng Is Nothing Then
With historyWks
' copy from FindRng untill last row in that column , "pass" the empty cells in the middle
.Range(FindRng.fRng, .Cells(.Rows.Count, FindRng.fRng.Column).End(xlUp)).Copy
End With
With PasteSht.Cells(1, Col)
.PasteSpecial xlPasteAll
.PasteSpecial xlPasteValues
End With
Col = Col + 1 ' I am moving one Column only if Find was Successful , avoid having empty columns
End If
End If
End If
Next Ctl
' use your original code here
' ....
End Sub
答案 3 :(得分：0)
再次感谢@TimWilliams的帮助。
这就是我所做的：
#ifndef FUNC_H__
#define FUNC_H__
#endif