移动数据并返回表单对象

我试图自动化一个电子表格来传输数据从一张纸到另一张纸,这取决于数据的前三个字符是什么。 例如,对于数据NDX 12/31/2012 P2600,我希望它被放置在NDX表格中。 所以我有一个数组(desArr()),将数据拆分到数组的不同位置,使得desArr(0)包含“NDX”,desArr(1)包含“12/31/2012”等等。

我遇到麻烦的部分是将数据移动到相应的工作表。 具体来说,我需要一个variables引用这些电子表格。 立即采取NDX表。 我知道我可以做NDX.cells(1,1)。粘贴或工作表(NDX.Name).Cells(1,1)。粘贴,这将工作,但如果我想这样做多张? 我显然可以使用If语句来定义每个不同的实例,但我想缩短我的代码。 因此,我试图使表单对象variables,即desArr(0).Name,但返回一个错误(我明白为什么)的引用。 任何人有关于如何实现这一目标的build议? 我知道一个解决scheme就是使用工作表的名称属性,但是如果有人更改了工作表的名称,我想避免我的代码失败的机会。

所以也许就像:

Dim desArr() As String, desInfo As String, opType As String Dim rNum As Long, cNum As Long, i As Long Dim wb As Workbook Dim ws As Worksheet Dim sortRng As Range, findRng As Range Dim j As Integer 'Throw away after testing Dim test As String 'Throw away after testing Dim k As Integer 'Throw away after testing Application.ScreenUpdating = False Application.DisplayAlerts = False Set wb = ThisWorkbook Set ws = wb.Worksheets(Import.Name) With ws rNum = .Range("C1048576").End(xlUp).Row cNum = 6 'Number of used columns starting from left Set sortRng = .Range(.Cells(3, 2), .Cells(rNum, cNum)) 'Sort range according to Type and Description sortRng.Sort _ Key1:=.Range("B1"), _ Key2:=.Range("C1") 'Apply conditional formatting With sortRng.Columns(2) .FormatConditions.AddUniqueValues .FormatConditions(.FormatConditions.Count).SetFirstPriority .FormatConditions(1).DupeUnique = xlDuplicate With sortRng.Columns(2).FormatConditions(1) .Interior.PatternColorIndex = xlAutomatic .Interior.Color = 13551615 .Interior.TintAndShade = 0 .StopIfTrue = False End With End With For i = 0 To (rNum - 2) With sortRng.Cells(i + 1, 2) If .DisplayFormat.Interior.Color = "13551615" Then j = 0 While (.Value = .Offset(j + 1, 0).Value And .Offset(0, 1).Value = .Offset(j + 1, 1).Value) j = j + 1 Wend If (j <> 0) Then 'There are duplicates End If End If 'Converting the description to format used for classification If .Offset(0, -1) = "Ext Option" Then desArr = Split(.Value, " ") If Not (Left(.Value, 3) = "SX5" Or Left(.Value, 3) = "UKX") Then 'check if it's a call or put If Left(desArr(3), 1) = "C" Then opType = "Call" ElseIf Left(desArr(3), 1) = "P" Then opType = "Put" Else opType = "N/A" End If desInfo = Format(desArr(2), "mmmdd") & " " & Right(Trim(desArr(3)), Len(Trim(desArr(3))) - 1) & " " & opType Else 'check if it's a call or put If Left(desArr(2), 1) = "C" Then opType = "Call" ElseIf Left(desArr(2), 1) = "P" Then opType = "Put" Else opType = "N/A" End If desInfo = Format(desArr(1), "mmmdd") & " " & Right(Trim(desArr(2)), Len(Trim(desArr(2))) - 1) & " " & opType End If End If End With Next i End With Application.ScreenUpdating = True Application.DisplayAlerts = True 

结束小组

除了NDX将不得不变成工作表来移动数据取决于数据。

您可以使用工作表的代码名称属性。 如果您使用NDX.Cells(1,1),NDX是工作表的代号。 只需search所有工作表,例如:

 Function GetWorksheet(byval withCodename as String) as Worksheet Dim sheetVar as Worksheet For each sheetVar in ThisWorkbook.Worksheets If sheetVar.CodeName = withCodename Then Set GetWorksheet = sheetVar End if Next End Function 

你可以:

防止用户重命名工作表

你写道:“如果有人改变了表的名字,我想避免我的代码失败的机会。”

那么,用户不能这样做: 在这里输入图像说明

如果你保护工作簿。 您可以在function区(“审阅”>“更改”>“保护工作簿”)中手动执行此操作,也可以通过编程方式执行此操作:

 ThisWorkbook.Protect 'optionally, add a password -- see documentation for Protect 

这将完全阻止用户更改工作表名称。