2012-09-02 15 views
5

मैं वीबीए का उपयोग कर एक्सेल की कुछ कोशिकाओं को पढ़ रहा हूं।एक्सेल से रेंज चर में एक रेंज कैसे स्टोर करें?

Function getData(currentWorksheet as Worksheet, dataStartRow as Integer, _ 
dataEndRow as Integer, DataStartCol as Integer, dataEndCol as Integer) 

    Dim dataTable as Range 
    dataTable = currentWorksheet.Range(currentWorksheet.Cells(dataStartRow, _ 
    dataStartCol), currentWorksheet.Cells(dataEndRow, dataEndCol)) 

    getData = dataTable 

EndFunction 

यह एक त्रुटि, ऑब्जेक्ट चर या ब्लॉक चर सेट के साथ फेंकता है। इस श्रेणी को एक चर में कैसे लेते हैं? कृपया मेरा मार्ग दर्शन कीजिए।

उत्तर

19

आप एक Range वस्तु का उपयोग करते हैं, तो आप बस निम्न सिंटैक्स का उपयोग नहीं कर सकते हैं:

Function getData(currentWorksheet As Worksheet, dataStartRow As Integer, dataEndRow As Integer, DataStartCol As Integer, dataEndCol As Integer) 

    Dim dataTable As Range 
    Set dataTable = currentWorksheet.Range(currentWorksheet.Cells(dataStartRow, DataStartCol), currentWorksheet.Cells(dataEndRow, dataEndCol)) 

    Set getData = dataTable 

End Function 

Sub main() 
    Dim test As Range 

    Set test = getData(ActiveSheet, 1, 3, 2, 5) 
    test.select 

End Sub 

ध्यान दें कि हर:

Dim myRange as Range 
myRange = Range("A1") 

आप रेंज वस्तुओं आवंटित करने के लिए set कीवर्ड का उपयोग करना चाहिए समय सीमा घोषित की गई है मैं Set कीवर्ड का उपयोग करता हूं।


आप भी अपनी getData समारोह एक Variant के बजाय एक Range वस्तु वापस जाने के लिए हालांकि इस समस्या को आप कर रहे हैं से संबंधित नहीं है अनुमति दे सकते हैं।

0

currentWorksheet क्या है? यह काम करता है यदि आप अंतर्निहित ActiveSheet का उपयोग करते हैं।

dataStartRow=1 
dataStartCol=1 
dataEndRow=4 
dataEndCol=4 
Set currentWorksheet=ActiveSheet 
dataTable = currentWorksheet.Range(currentWorksheet.Cells(dataStartRow, dataStartCol), currentWorksheet.Cells(dataEndRow, dataEndCol)) 
+0

currentWorksheet में एक समारोह के लिए एक augmenter के रूप में पारित हो जाता है से जो कथन है। यह शीट 2 है। यह अभी भी वही त्रुटि फेंक रहा है, हालांकि मैं कहता हूं कि वर्तमान वर्कशीट सेट करें - एक्टिवशीट –

+0

@ प्रियांकाखकर कृपया * पूरा * संदर्भ दिखाने के लिए अपना प्रश्न अपडेट करें। क्योंकि मेरे द्वारा पोस्ट किया गया कोड काम करता है (मैंने इसका परीक्षण किया) –

+0

सुनिश्चित करें। क्या वह –

0

परिभाषित करें कि GetData क्या है। फिलहाल इसे परिभाषित नहीं किया गया है।

0

अपने मंद को एक संस्करण के रूप में घोषित करें, और डेटा को एक सरणी से खींचें। अर्थात

Dim y As Variant 
y = Range("A1:B2") 

अब आप अपने एक्सेल रेंज, सभी 1 चर (सरणी) है y

डेटा खींच करने के लिए, श्रेणी में सरणी स्थिति कॉल "A1: B2" या जो भी आप चुनें। उदाहरण:

Msgbox y(1, 1) 

यह "ए 1: बी 2" श्रेणी में शीर्ष बाएं बॉक्स को वापस कर देगा।

-1

यहाँ एक उदाहरण है कि वांछित क्षेत्रों में से प्रत्येक लाइन पर कोड के प्रदर्शन के लिए अनुमति देता है (लेने या तो चयन के शीर्ष & नीचे, के चयन से

Sub doROWSb()   'WORKS for do selected rows  SEE FIX ROWS ABOVE (small ver) 
Dim E7 As String 'note: workcell E7 shows: BG381 
E7 = RANGE("E7") 'see eg below 
Dim r As Long  'NOTE: this example has a paste formula(s) down a column(s). WILL REDUCE 10 HOUR DAYS OF PASTING COLUMNS, DOWN TO 3 MINUTES? 
Dim c As Long 
Dim rCell As RANGE 
'Dim LastRow As Long 
r = ActiveCell.row 
c = ActiveCell.Column 'might not matter if your code affects whole line anyways, still leave as is 

Dim FirstRow As Long 'not in use, Delete if only want last row, note: this code already allows for selection as start 
Dim LastRow As Long 


If 1 Then  'if you are unable to delete rows not needed, just change 2 lines from: If 1, to if 0 (to go from selection last row, to all rows down from selection) 
With Selection 
    'FirstRow = .Rows(1).row     'not used here, Delete if only want last row 
    LastRow = .Rows(.Rows.Count).row  'find last row in selection 
End With 
application.CutCopyMode = False    'if not doing any paste op below 
Else 
    LastRow = Cells(Rows.Count, 1).End(xlUp).row 'find last row used in sheet 
End If 
application.EnableEvents = True    'EVENTS need this? 
application.ScreenUpdating = False   'offset-cells(row, col) 
'RANGE(E7).Select 'TOP ROW SELECT 
RANGE("A1") = vbNullString     'simple macros on-off switch, vb not here: If RANGE("A1").Value > 0 Then 


For Each rCell In RANGE(Cells(r, c), Cells(LastRow, c)) 'new 
    rCell.Select 'make 3 macros for each paste macro below 
'your code here: 

If 1 Then  'to if 0, if want to paste formulas/formats/all down a column 
    Selection.EntireRow.Calculate  'calcs all selected rows, even if just selecting 1 cell in each row (might only be doing 1 row aat here, as part of loop) 
Else 
'dorows() DO ROWS() 
'eg's for paste cells down a column, can make 3 separate macros for each: sub alte() altf & altp 
     Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'make sub alte() add thisworkbook: application.OnKey "%{e}", "alte" 
     'Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False  'make sub altf() add thisworkbook: application.OnKey "%{f}", "altf" 
     'Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False   'amke sub altp() add thisworkbook: application.OnKey "%{p}", "altp" 
End If 
Next rCell 

'application.CutCopyMode = False   'finished - stop copy mode 
'RANGE("A2").Select 
goBEEPS (2), (0.25)  'beeps secs 
application.EnableEvents = True    'EVENTS 

'note: workcell E7 has: SUBSTITUTE(SUBSTITUTE(CELL("address",$BG$369),"$",""),"","") 
'other col eg (shows: BG:BG): =SUBSTITUTE(SUBSTITUTE(CELL("address",$BG2),"$",""),ROW(),"")&":"& SUBSTITUTE(SUBSTITUTE(CELL("address",$BG2),"$",""),ROW(),"") 
End Sub 


'OTHER: 
Sub goBEEPSx(b As Long, t As Double) 'beeps secs as: goBEEPS (2), (0.25) OR: goBEEPS(2, 0.25) 
    Dim dt 'as double 'worked wo as double 
    Dim x 
    For b = b To 1 Step -1 
    Beep 
    x = Timer 
    Do 
    DoEvents 
    dt = Timer - x 
    If dt < 0 Then dt = dt + 86400 '86400 no. seconds in a day, in case hit midnight & timer went down to 0 
    Loop Until dt >= t 
    Next 
End Sub 
संबंधित मुद्दे