एक्सेल वीबीए - एक 2 डी सरणी कैसे Redim करने के लिए?

Question

विजुअल बेसिक के माध्यम से एक्सेल में, मैं एक्सेल में लोड की गई चालान की एक CSV फ़ाइल के माध्यम से पुनरावृत्ति कर रहा हूं। चालान ग्राहक द्वारा निर्धारित निर्धारक पैटर्न में हैं।

मैं उन्हें एक गतिशील 2 डी सरणी में पढ़ रहा हूं, फिर उन्हें पुराने चालानों के साथ किसी अन्य वर्कशीट में लिख रहा हूं। मैं समझता हूं कि मुझे पंक्तियों और स्तंभों को पीछे हटाना है क्योंकि केवल सरणी के अंतिम आयाम को Redimmed किया जा सकता है, फिर जब मैं इसे मास्टर वर्कशीट में लिखता हूं तो ट्रांसफर करें।

कहीं, मेरे पास वाक्यविन्यास गलत है। यह मुझे बताता रहता है कि मैंने पहले ही सरणी को आयामीकृत कर दिया है। किसी तरह मैंने इसे एक स्थिर सरणी के रूप में बनाया था? इसे गतिशील रूप से संचालित करने के लिए मुझे क्या ठीक करने की आवश्यकता है?

काम संहिता प्रति जवाब दिया

Sub InvoicesUpdate() 
' 
'Application Settings 
Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
Application.Calculation = xlCalculationManual 

'Instantiate control variables 
Dim allRows As Long, currentOffset As Long, invoiceActive As Boolean, mAllRows As Long 
Dim iAllRows As Long, unusedRow As Long, row As Long, mWSExists As Boolean, newmAllRows As Long 

'Instantiate invoice variables 
Dim accountNum As String, custName As String, vinNum As String, caseNum As String, statusField As String 
Dim invDate As String, makeField As String, feeDesc As String, amountField As String, invNum As String 

'Instantiate Workbook variables 
Dim mWB As Workbook 'master 
Dim iWB As Workbook 'import 

'Instantiate Worksheet variables 
Dim mWS As Worksheet 
Dim iWS As Worksheet 

'Instantiate Range variables 
Dim iData As Range 

'Initialize variables 
invoiceActive = False 
row = 0 

'Open import workbook 
Workbooks.Open ("path:excel_invoices.csv") 
Set iWB = ActiveWorkbook 
Set iWS = iWB.Sheets("excel_invoices.csv") 
iWS.Activate 
Range("A1").Select 
iAllRows = iWS.UsedRange.Rows.Count 'Count rows of import data 

'Instantiate array, include extra column for client name 
Dim invoices() 
ReDim invoices(10, 0) 

'Loop through rows. 
Do 

    'Check for the start of a client and store client name 
    If ActiveCell.Value = "Account Number" Then 

     clientName = ActiveCell.Offset(-1, 6).Value 

    End If 

    If ActiveCell.Offset(0, 3).Value <> Empty And ActiveCell.Value <> "Account Number" And ActiveCell.Offset(2, 0) = Empty Then 

     invoiceActive = True 

     'Populate account information. 
     accountNum = ActiveCell.Offset(0, 0).Value 
     vinNum = ActiveCell.Offset(0, 1).Value 
     'leave out customer name for FDCPA reasons 
     caseNum = ActiveCell.Offset(0, 3).Value 
     statusField = ActiveCell.Offset(0, 4).Value 
     invDate = ActiveCell.Offset(0, 5).Value 
     makeField = ActiveCell.Offset(0, 6).Value 

    End If 

    If invoiceActive = True And ActiveCell.Value = Empty And ActiveCell.Offset(0, 6).Value = Empty And ActiveCell.Offset(0, 9).Value = Empty Then 

     'Make sure something other than $0 was invoiced 
     If ActiveCell.Offset(0, 8).Value <> 0 Then 

      'Populate individual item values. 
      feeDesc = ActiveCell.Offset(0, 7).Value 
      amountField = ActiveCell.Offset(0, 8).Value 
      invNum = ActiveCell.Offset(0, 10).Value 

      'Transfer data to array 
      invoices(0, row) = "=TODAY()" 
      invoices(1, row) = accountNum 
      invoices(2, row) = clientName 
      invoices(3, row) = vinNum 
      invoices(4, row) = caseNum 
      invoices(5, row) = statusField 
      invoices(6, row) = invDate 
      invoices(7, row) = makeField 
      invoices(8, row) = feeDesc 
      invoices(9, row) = amountField 
      invoices(10, row) = invNum 

      'Increment row counter for array 
      row = row + 1 

      'Resize array for next entry 
      ReDim Preserve invoices(10,row) 

     End If 

    End If 

    'Find the end of an invoice 
    If invoiceActive = True And ActiveCell.Offset(0, 9) <> Empty Then 

     'Set the flag to outside of an invoice 
     invoiceActive = False 

    End If 

    'Increment active cell to next cell down 
    ActiveCell.Offset(1, 0).Activate 

'Define end of the loop at the last used row 
Loop Until ActiveCell.row = iAllRows 

'Close import data file 
iWB.Close 

Answer 1

यह ठीक सहज नहीं है, लेकिन आप (VB6 Ref) ReDim नहीं कर सकते हैं एक सरणी यदि आप इसे आयामों के साथ मंद। लिंक किए गए पृष्ठ से सटीक उद्धरण है:

ReDim बयान आकार के लिए इस्तेमाल किया या एक गतिशील सरणी है पहले से ही औपचारिक रूप से एक निजी, सार्वजनिक उपयोग करते हुए घोषित किया गया, आकार बदलना या (खाली कोष्ठकों साथ बयान मंद आयाम के बिना है सबस्क्रिप्ट)।

दूसरे शब्दों में, बजाय dim invoices(10,0)

की आप

Dim invoices() 
Redim invoices(10,0) 

तब का उपयोग करना चाहिए जब आप ReDim, आप का उपयोग करने के Redim Preserve (10,row)

चेतावनी की आवश्यकता होगी: जब Redimensioning बहुआयामी सरणी, यदि आप अपने मूल्यों को संरक्षित करना चाहते हैं, तो आप केवल अंतिम आयाम बढ़ा सकते हैं। अर्थात। Redim Preserve (11,row) या यहां तक ​​कि (11,0) विफल हो जाएगा।

Answer 2

इस सड़क को मारने के दौरान मैंने इस सवाल पर ठोकर खाई। मैंने इस नए ReDim Preserve को एक नए आकार के सरणी (पहले या अंतिम आयाम) पर संभालने के लिए वास्तविक कोड का एक टुकड़ा लिखना समाप्त कर दिया। शायद यह उन लोगों की मदद करेगा जो एक ही मुद्दे का सामना करते हैं।

तो उपयोग के लिए, मान लें कि आपने अपनी सरणी मूल रूप से MyArray(3,5) के रूप में सेट की है, और आप आयाम (पहले भी!) बड़ा बनाना चाहते हैं, बस MyArray(10,20) पर कहें। आप इस तरह कुछ करने के लिए इस्तेमाल किया जाएगा?

ReDim Preserve MyArray(10,20) '<-- Returns Error 

लेकिन दुर्भाग्य से यह एक त्रुटि देता है क्योंकि आपने पहले आयाम के आकार को बदलने की कोशिश की थी। तो मेरे काम के साथ, आप इसके बजाय कुछ ऐसा करेंगे:

MyArray = ReDimPreserve(MyArray,10,20) 

अब सरणी बड़ी है, और डेटा संरक्षित है। मल्टी-आयाम सरणी के लिए आपका ReDim Preserve पूर्ण हो गया है।:)

और अंत में कम से कम, चमत्कारी समारोह: ReDimPreserve()

'redim preserve both dimensions for a multidimension array *ONLY 
Public Function ReDimPreserve(aArrayToPreserve,nNewFirstUBound,nNewLastUBound) 
    ReDimPreserve = False 
    'check if its in array first 
    If IsArray(aArrayToPreserve) Then  
     'create new array 
     ReDim aPreservedArray(nNewFirstUBound,nNewLastUBound) 
     'get old lBound/uBound 
     nOldFirstUBound = uBound(aArrayToPreserve,1) 
     nOldLastUBound = uBound(aArrayToPreserve,2)   
     'loop through first 
     For nFirst = lBound(aArrayToPreserve,1) to nNewFirstUBound 
      For nLast = lBound(aArrayToPreserve,2) to nNewLastUBound 
       'if its in range, then append to new array the same way 
       If nOldFirstUBound >= nFirst And nOldLastUBound >= nLast Then 
        aPreservedArray(nFirst,nLast) = aArrayToPreserve(nFirst,nLast) 
       End If 
      Next 
     Next    
     'return the array redimmed 
     If IsArray(aPreservedArray) Then ReDimPreserve = aPreservedArray 
    End If 
End Function 

मैं इस 20 मिनट की तरह में लिखा है, तो वहाँ कोई गारंटी नहीं है। लेकिन अगर आप इसका उपयोग करना या विस्तार करना चाहते हैं, तो नि: शुल्क महसूस करें। मैंने सोचा होगा कि किसी के पास पहले से ही कुछ कोड होगा, जाहिर है। तो यहाँ साथी साथी जाओ।

Answer 3

यहाँ variabel घोषणा के साथ ReDim preseve विधि का कोड अद्यतन किया जाता है, आशा है कि @Control फ्रीक इसके साथ ठीक है :)

Option explicit 
'redim preserve both dimensions for a multidimension array *ONLY 
Public Function ReDimPreserve(aArrayToPreserve As Variant, nNewFirstUBound As Variant, nNewLastUBound As Variant) As Variant 
    Dim nFirst As Long 
    Dim nLast As Long 
    Dim nOldFirstUBound As Long 
    Dim nOldLastUBound As Long 

    ReDimPreserve = False 
    'check if its in array first 
    If IsArray(aArrayToPreserve) Then 
     'create new array 
     ReDim aPreservedArray(nNewFirstUBound, nNewLastUBound) 
     'get old lBound/uBound 
     nOldFirstUBound = UBound(aArrayToPreserve, 1) 
     nOldLastUBound = UBound(aArrayToPreserve, 2) 
     'loop through first 
     For nFirst = LBound(aArrayToPreserve, 1) To nNewFirstUBound 
      For nLast = LBound(aArrayToPreserve, 2) To nNewLastUBound 
       'if its in range, then append to new array the same way 
       If nOldFirstUBound >= nFirst And nOldLastUBound >= nLast Then 
        aPreservedArray(nFirst, nLast) = aArrayToPreserve(nFirst, nLast) 
       End If 
      Next 
     Next 
     'return the array redimmed 
     If IsArray(aPreservedArray) Then ReDimPreserve = aPreservedArray 
    End If 
End Function 

Answer 4

मैं जानता हूँ कि यह एक सा पुराना है लेकिन मैं एक बहुत सरल हो सकता है लगता है समाधान जिसके लिए कोई अतिरिक्त कोडिंग की आवश्यकता नहीं है:

ट्रांसपोज़िंग, रेडिमिंग और ट्रांसपोज़िंग करने के बजाय, और यदि हम दो आयामी सरणी के बारे में बात करते हैं, तो क्यों न केवल मूल्यों को स्थानांतरित करने के लिए स्थानांतरित करें। उस मामले में रेडिम संरक्षित वास्तव में शुरुआत से दाएं (दूसरे) आयाम को बढ़ाता है। या दूसरे शब्दों में, इसे विज़ुअलाइज़ करने के लिए, दो स्तंभों के बजाय दो पंक्तियों में क्यों स्टोर न करें यदि केवल स्तंभों के एनआरडी को रेडिम संरक्षित के साथ बढ़ाया जा सकता है।

सूचकांक 00-01, 01-11, 02-12, 03-13, 04-14, 05-15 ... 00-01, 10-11 के बजाय 0 25-1 25 आदि , 20-21, 30-31, 40-41 आदि।

जैसे ही दूसरे (या अंतिम) आयाम को रिडीमिंग के दौरान संरक्षित किया जा सकता है, कोई भी तर्क दे सकता है कि इस तरह से एरे का उपयोग शुरू करने के लिए किया जाना चाहिए। मैंने इस समाधान को कहीं भी नहीं देखा है, तो शायद मैं कुछ दिख रहा हूं?