我有看你有给我的代码,这是我原来的你。
而不是使用IF语句,我用Select Case语句,这使得事情变得更简单/和清洁负荷。
用VBA你需要指定变量,然后什么值包含(例如:X = 10,而不是10 = X)和一些变量需要进行设置,(如范围,工作簿和工作表)
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B5")) Is Nothing Then Rate
End Sub
Sub Rate()
Dim text As String
Dim Rate As Range
text = Range("B5").Value
Set Rate = Range("B10")
Select Case text
Case "BRUBRU"
Rate.Formula = "=vlookup(B12,DataStore!$A$4:$F$461,2,FALSE)"
Case "BRUEUR"
Rate.Formula = "=VLookup(B12,DataStore!$A$4:$F$461,3,FALSE)"
Case "BRUBRI"
Rate.Formula = "=VLookup(B12,DataStore!$A$4:$F$461,4,FALSE)"
Case "BRUSTA"
Rate.Formula = "=VLookup(B12,DataStore!$A$4:$F$461,5,FALSE)"
Case "BRUAIR"
Rate.Formula = "=VLookup(B12,DataStore!$A$4:$F$461,6,FALSE)"
End Select
End Sub
当打开工作簿不会延长文档的打开时间时,您可以让您的代码将您的Rates.xlsx中的信息复制到隐藏的工作表中。
我很想要求这项工作作为我自己,但我已经做了一些谷歌上搜索,发现应该工作的解决方案。这是帮助我解决问题的网站。 http://www.rondebruin.nl/
我已经改变了上面的代码与新工作表工作,使你的代码需要一些更新这个工作。
此代码是当你打开文件,就走了进去的ThisWorkbook:
Private Sub Workbook_Open()
Dim SaveDriveDir As String, MyPath As String
Dim FName As Variant
Dim SDataWS As Worksheet
SaveDriveDir = CurDir
MyPath = Application.ActiveWorkbook.Path ' "C:\Data" or use Application.DefaultFilePath - Takes you to your defult save folder
ChDrive MyPath
ChDir MyPath
FName = Application.ActiveWorkbook.Path & "\RATES.xlsx"
'If your file which has the data in is in the same folder, this shouldn't need adjusting
'Alternatively you could search for the file each time by using - Application.GetOpenFilename(filefilter:="Excel Files, *.xl*")
If FName = False Then
'do nothing
Else
On Error Resume Next
Set SDataWS = Sheets("DataStore")
If SDataWS Is Nothing Then
Sheets.Add.Name = "DataStore"
With Sheets("DataStore")
.Visible = False
End With
End If
On Error GoTo 0
GetData FName, "Sheet1", "A1:F461", Sheets("DataStore").Range("A1"), False, False
End If
End Sub
这部分进入你的模块:
Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
SourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)
' 30-Dec-2007, working in Excel 2000-2007
Dim rsCon As Object
Dim rsData As Object
Dim szConnect As String
Dim szSQL As String
Dim lCount As Long
' Create the connection string.
If Header = False Then
If Val(Application.Version) < 12 Then
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=No"";"
Else
szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=No"";"
End If
Else
If Val(Application.Version) < 12 Then
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"
Else
szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes"";"
End If
End If
If SourceSheet = "" Then
' workbook level name
szSQL = "SELECT * FROM " & SourceRange$ & ";"
Else
' worksheet level name or range
szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
End If
On Error GoTo SomethingWrong
Set rsCon = CreateObject("ADODB.Connection")
Set rsData = CreateObject("ADODB.Recordset")
rsCon.Open szConnect
rsData.Open szSQL, rsCon, 0, 1, 1
' Check to make sure we received data and copy the data
If Not rsData.EOF Then
If Header = False Then
TargetRange.Cells(1, 1).CopyFromRecordset rsData
Else
'Add the header cell in each column if the last argument is True
If UseHeaderRow Then
For lCount = 0 To rsData.Fields.Count - 1
TargetRange.Cells(1, 1 + lCount).Value = _
rsData.Fields(lCount).Name
Next lCount
TargetRange.Cells(2, 1).CopyFromRecordset rsData
Else
TargetRange.Cells(1, 1).CopyFromRecordset rsData
End If
End If
Else
MsgBox "No records returned from : " & SourceFile, vbCritical
End If
' Clean up our Recordset object.
rsData.Close
Set rsData = Nothing
rsCon.Close
Set rsCon = Nothing
Exit Sub
SomethingWrong:
MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
vbExclamation, "Error"
On Error GoTo 0
End Sub
希望这有助于!
克雷格
而是在全员出动键入每个公式,为什么不设置一个新的变量,比如,信息columnCount,然后转到“如果text =” BRUBRU“然后=信息columnCount 2 ......”,然后在最后你只需要你的公式,而不是硬编码一列#,用columnCount替换该数字。将会更清楚一点,你正在做的是设置专栏基于测试,并且你没有改变其他任何东西。 –