2012-10-09 22 views
5

का उपयोग कर एक्सेल में एकाधिक सेलों की गणना के ओपूट फ़ंक्शन परिणाम एक्सेल में एक फ़ंक्शन प्रोग्राम करने के लिए वीबीए का उपयोग करके मैं कुछ नामों की तलाश करने वाली सूची खोजूंगा, जब कुछ नामों की मांग की जाती है तो गिनती करें और फिर इन काउंटर मूल्यों को व्यक्तिगत रूप से आउटपुट करें कोशिकाओं।वीबीए

जब मेरे पास बहु सेल फ़ंक्शन होता है तो मैं फ़ंक्शन पर मान कैसे आवंटित करूं? मैंने एक ही कॉलम में एक दूसरे के बगल में 4 कोशिकाओं को चुना है और एक बहु सेल फ़ंक्शन प्राप्त करने के लिए CTRL-SHFT-ENTER दबाया है, मुझे नहीं पता कि फ़ंक्शन में परिणाम आवंटित करने के लिए कैसे करें ताकि यह चयनित कक्षों में दिखाया जा सके। जो मैंने अभी तक किया है वह नीचे दिखाया गया है:

Function ROM(ByVal lookup_value As Range, _ 
ByVal lookup_column As Range, _ 
ByVal return_value_column As Long) As String 

Application.ScreenUpdating = False 

Dim i As Long 
Dim resultCount As Long 
Dim resultsArray() As String 
Dim arraySize As Long 
Dim myrange As Range 
Dim results As String 
Dim TSS As Long 
Dim OSS As Long 
Dim AWS As Long 
Dim JLI As Long 
Dim answers(1 To 3, 1 To 1) As Variant 


' The following code works out how many matches there are for the lookup and creates an 
' array of the same size to hold these results 

Set myrange = lookup_column 
arraySize = Application.WorksheetFunction.CountIf(myrange, lookup_value.Value) 
ReDim resultsArray(arraySize - 1) 

' A counter for the results 

resultCount = 0 
TSS = 0 
OSS = 0 
AWS = 0 
JLI = 0 

' The equipment ID column is looped through and for every match the corresponding Equipment Type is 
' saved into the resultsArray for analysis 

For i = 1 To lookup_column.Rows.count 
    If Len(lookup_column(i, 1).Text) <> 0 Then 
     If lookup_column(i, 1).Text = lookup_value.Value Then 

       ' If statement to ensure that the function doesnt cycle to a number larger than the 
       ' size of resultsArray 

       If (resultCount < (arraySize)) Then 
        resultsArray(resultCount) = (lookup_column(i).Offset(0, return_value_column).Text) 
        results = (lookup_column(i).Offset(0, return_value_column).Text) 
        resultCount = resultCount + 1 
         ' The following code compares the string to preset values and increments 
         ' the counters if any are found in the string 

         If (InStr(results, "TPWS TSS") > 0) Then 
          TSS = TSS + 1 

         ElseIf (InStr(results, "TPWS OSS")) Then 
          OSS = OSS + 1 

         ElseIf (InStr(results, "JUNCTION INDICATOR (1 Route)") > 0) Then 
          JLI = JLI + 1 

         ElseIf (InStr(results, "AWS")) Then 
          AWS = AWS + 1 

         End If 

       End If 
     End If 
    End If 
Next 

answers(1, 1) = TSS 
answers(1, 2) = OSS 
answers(1, 3) = AWS 
answers(1, 4) = 0 

    ROM = answers  


Application.ScreenUpdating = True 


End Function 

जब मैं फ़ंक्शन चलाने का प्रयास करता हूं तो यह उत्तर के लिए प्रकार मिलान नहीं करता रहता है। बहु सेल सूत्र के लिए चयनित कोशिकाएं F18, G18, H18 और I18 हैं।

उत्तर

5

VBA

से सरणी कार्यों लौटने के लिए
  1. अपने समारोह प्रकार संस्करण का होना चाहिए
  2. अपने उत्पादन सरणी चयनित श्रेणी से मेल खाना चाहिए - अपने मामले में यह 1-आयामी होना चाहिए आप dimensioning कर रहे हैं, जबकि एक 2-आयामी सरणी

इस

Function MyArray() As Variant 
Dim Tmp(3) As Variant 

    Tmp(0) = 1 
    Tmp(1) = "XYZ" 
    Tmp(2) = 3 
    Tmp(3) = 4 

    MyArray = Tmp 

End Function 
प्रयास करें

अब F18..I18, enter = MyArray() दर्ज करें और Ctrl + Shift + Enter

दबाएं इससे उम्मीद है कि यह मदद करता है।

+0

धन्यवाद! वह चाल है। – Ashmanq

1

सबसे पहले, आपको टाइप मिस्चैच मिल रहा है क्योंकि आप परिणाम को स्ट्रिंग में असाइन करने का प्रयास कर रहे हैं। यदि आप एक संस्करण को असाइन करते हैं तो आप उस समस्या से बचेंगे।

दूसरा, अपने answers सरणी के रूप में dimensioned किया जाना चाहिए:

Dim answers(3) As Variant

अगर मैं समस्या समझ लिया है सही ढंग से निम्नलिखित कोड आप के लिए काम करना चाहिए।

Function ROM(ByVal lookup_value As Range, _ 
ByVal lookup_column As Range, _ 
ByVal return_value_column As Long) As Variant 

Application.ScreenUpdating = False 

Dim i As Long 
Dim resultCount As Long 
Dim resultsArray() As String 
Dim arraySize As Long 
Dim myrange As Range 
Dim results As String 
Dim TSS As Long 
Dim OSS As Long 
Dim AWS As Long 
Dim JLI As Long 
Dim answers(3) As Variant 


' The following code works out how many matches there are for the lookup and creates an 
' array of the same size to hold these results 

Set myrange = lookup_column 
arraySize = Application.WorksheetFunction.CountIf(myrange, lookup_value.Value) 
ReDim resultsArray(arraySize - 1) 

' A counter for the results 

resultCount = 0 
TSS = 0 
OSS = 0 
AWS = 0 
JLI = 0 

' The equipment ID column is looped through and for every match the corresponding Equipment Type is 
' saved into the resultsArray for analysis 

For i = 1 To lookup_column.Rows.Count 
    If Len(lookup_column(i, 1).Text) <> 0 Then 
     If lookup_column(i, 1).Text = lookup_value.Value Then 

       ' If statement to ensure that the function doesnt cycle to a number larger than the 
       ' size of resultsArray 

       If (resultCount < (arraySize)) Then 
        resultsArray(resultCount) = (lookup_column(i).Offset(0, return_value_column).Text) 
        results = (lookup_column(i).Offset(0, return_value_column).Text) 
        resultCount = resultCount + 1 
         ' The following code compares the string to preset values and increments 
         ' the counters if any are found in the string 

         If (InStr(results, "TPWS TSS") > 0) Then 
          TSS = TSS + 1 

         ElseIf (InStr(results, "TPWS OSS")) Then 
          OSS = OSS + 1 

         ElseIf (InStr(results, "JUNCTION INDICATOR (1 Route)") > 0) Then 
          JLI = JLI + 1 

         ElseIf (InStr(results, "AWS")) Then 
          AWS = AWS + 1 

         End If 

       End If 
     End If 
    End If 
Next 

answers(0) = TSS 
answers(1) = OSS 
answers(2) = AWS 
answers(3) = 0 

    ROM = answers 


Application.ScreenUpdating = True 


End Function 
1

यह आपके द्वारा उपयोग किए जा रहे एक्सेल के संस्करण के आधार पर भिन्न हो सकता है। मैं Office2003 सूट का उपयोग कर रहा हूं और ऊपर दिए गए समाधान एक्सेल के इस संस्करण के साथ काम नहीं करते हैं।

मुझे लगता है कि आपको दूसरे आयाम में मानों के साथ एक्सेल में दो आयामी सरणी आउटपुट की आवश्यकता है।

मैं ऊपर माइकडी के उदाहरण उधार लेगा और इसे Excel2003 में काम करने के लिए संशोधित करूंगा।

Function MyArray() As Variant 
Dim Tmp() As Variant 

redim Tmp(3,0) as Variant 

Tmp(0,0) = 1 
Tmp(1,0) = "XYZ" 
Tmp(2,0) = 3 
Tmp(3,0) = 4 

MyArray = Tmp 

End Function 

ध्यान दें कि आप फिर से diminsion कर सकते हैं अपने सरणी एक गतिशील उत्पादन का उपयोग करने के लिए, लेकिन आप जब आप Excel में समारोह डालने अपने उत्पादन के सभी शामिल करने के लिए एक बहुत बड़ी रेंज का चयन करना होगा।