मुझे यकीन नहीं है कि इसे Google खोज में कैसे समझाया जाए, इसलिए मुझे यकीन नहीं है कि किसी और ने यह पूछा है या नहीं।

मेरे पास एक वीबीए फ़ंक्शन है जो एक सीमा लेता है और इसे अल्पविराम से अलग मानों की एक स्ट्रिंग में बदल देता है। यह एक सम्मोहन की तरह काम करता है।

अब मैं चाहता हूं कि यह केवल पहली 41 प्रविष्टियों को आउटपुट करे, एक पंक्ति को स्विच करे और अगली 41 प्रविष्टियों को सीमा में आउटपुट करे।

मैं इसके चारों ओर अपना सिर नहीं लपेट सकता, यह एक साधारण लूप की तरह लगता है लेकिन मैं वहां नहीं पहुंच सकता।

मुझे csvrange मैक्रो ऑनलाइन कहीं मिला :)

Function csvRange(myRange As Range)    
    Dim csvRangeOutput
    Dim entry As Variant    
    For Each entry In myRange    
        If Not IsEmpty(entry.Value) Then
            csvRangeOutput = csvRangeOutput & entry.Value & ","
        End If   
    Next
    csvRange = Left(csvRangeOutput, Len(csvRangeOutput) - 1)
End Function

इनपुट रेंज कुछ इस तरह दिखेगी
यहां छवि विवरण दर्ज करें

वांछित आउटपुट इस तरह दिखेगा, कॉलम बी में स्थित एक स्ट्रिंग 41 मानों के प्रत्येक समूह को एक पंक्ति पर अलग किया जाता है, हर बार फ़ंक्शन अगले एनआर 42 को हिट करता है।

enter image description here

0
Michael Christensen 29 अक्टूबर 2020, 12:54

2 जवाब

सबसे बढ़िया उत्तर

कुछ इस तरह:

Option Explicit

Public Sub test()

    Debug.Print csvRange(Selection, 41)

End Sub

Public Function csvRange(ByVal myRange As Range, ByVal Columns As Long) As String
    Dim csvRangeOutput
    Dim iCol As Long

    Dim Entry As Variant
    For Each Entry In myRange
        If Not IsEmpty(Entry.Value) Then
            iCol = iCol + 1
            csvRangeOutput = csvRangeOutput & Entry.Value
    
            If iCol = Columns Then
                csvRangeOutput = csvRangeOutput & vbCrLf
                iCol = 0
            Else
                csvRangeOutput = csvRangeOutput & ","
            End If
        End If
    Next
    
    csvRange = Left$(csvRangeOutput, Len(csvRangeOutput) - 1)
End Function

इस डेटा को चालू कर देगा

enter image description here

41 कॉलम के साथ अल्पविराम से अलग किए गए मानों में

1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41
42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82
83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123
124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,140

विकल्प

Public Sub Convert()
    Const ColCount As Long = 41
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    Dim iRow As Long
    For iRow = 1 To LastRow Step ColCount
        ws.Cells(iRow \ ColCount + 1, "B").Value = "'" & Join((WorksheetFunction.Transpose(ws.Range("A" & iRow).Resize(RowSize:=IIf(iRow + ColCount - 1 > LastRow, WorksheetFunction.Max(LastRow Mod ColCount, 2), ColCount)).Value)), ",")
    Next iRow
End Sub
0
Pᴇʜ 29 अक्टूबर 2020, 14:17

कृपया, अगले कोड का परीक्षण करें। कॉलम ए: ए में आपके पास जितने रिकॉर्ड हैं, यह वही करेगा (मुझे समझ में आया)। यह तेज होना चाहिए, सरणियों का उपयोग करना और स्मृति में काम करना। रेंज स्लाइस की आवश्यक संख्या के लिए एकल पुनरावृत्ति है:

Private Sub testStringCSVArray()
  Dim sh As Worksheet, arr, nrSlices As Long, LastRow As Long, rngF As Range
  Dim rngStart As Range, i As Long, k As Long, h As Long, arrFin
  
  Set sh = ActiveSheet
  LastRow = sh.Range("A1").End(xlDown).row
  LastRow = sh.Range("A" & rows.count).End(xlUp).row 'last row of A:A
  arr = sh.Range("A1:A" & LastRow).Value             'put the range in an array

  nrSlices = UBound(arr) \ 41                    'determine the number of necessary slices
  ReDim arrFin(nrSlices + 1)
  Set rngStart = sh.Range("B" & UBound(arr) + 2) 'set the cell where the result to be returned
  For i = 1 To nrSlices + 1
      arrFin(h) = CStr(Join(Application.Transpose(Application.Index(arr, _
             Evaluate("row(" & k + 1 & ":" & IIf(i <= nrSlices, 41 + k, UBound(arr)) & ")"), 1)), ","))
     k = k + 41: h = h + 1
  Next i
  'Format the range where the processed data will be returned and drop the processed data array:
  With rngStart.Resize(h, 1)
      .NumberFormat = "@"
      .Value = WorksheetFunction.Transpose(arrFin)
  End With
End Sub

पहले से संसाधित डेटा को हटाने से बचने के लिए, कोड को दो बार या अधिक बार चलाने की इच्छा के मामले में, संसाधित डेटा कॉलम बी: बी में कॉलम ए: ए में अंतिम सेल से दो पंक्तियों में वापस कर दिया जाएगा। यदि परीक्षण के बाद, कोड विश्वसनीय साबित होता है और इसे एक बार फिर चलाने की आवश्यकता नहीं है, तो Set rngStart = sh.Range("B" & UBound(arr) + 2) को Set rngStart = sh.Range("A" & UBound(arr) + 2) में संशोधित किया जा सकता है।

पाठ के रूप में प्रारंभिक स्वरूपण के बिना जिस क्षेत्र में डेटा छोड़ा जाएगा, एक्सेल NumberFormat को "वैज्ञानिक" में बदल देता है, जब अल्पविराम सीमांकित स्ट्रिंग में (केवल) तीन अंकों की संख्या होती है। ऐसा लगता है कि अल्पविराम को हजारों विभाजक के रूप में माना जाता है ...

0
FaneDuru 29 अक्टूबर 2020, 23:03