Új hozzászólás Aktív témák

• #16908 Mutt senior tag detroitrw #16893

  Új Válasz 2013-02-24 20:16:07 #16908

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Mutt

  senior tag

  válasz detroitrw #16893 üzenetére

  Hello,

  adott:
  A1=1603+1603+640+640+640+388+388 -> pl. B1=2db - 1603

  Gondolom a számok is változnak (nem mindig csak 1603, 640 és 388 ismétlődik), ezért csak függvényekkel megoldani körülményes, javaslatom a lenti makró (mindig csak a kijelölt cellát vizsgálja):

  Sub Szetszed()
  Dim arraySplit
  Const strDelimiter As String * 1 = "+" 'tagolás jele
  Dim arrayResult() 'itt lesznek a darabszámok és a számok/karakterek
  Dim c As Long, i As Long
  Dim blnHit As Boolean 'logikai jelző ha már létezik a vizsgált szám
  
  arraySplit = Split(ActiveCell.Value, strDelimiter)
  
  If IsArray(arraySplit) And UBound(arraySplit) > 0 Then
  ReDim arrayResult(1 To 2, 1) 'találat létrehozása
  arrayResult(1, 1) = 1 '1 db
  arrayResult(2, 1) = arraySplit(0) 'első érték megjegyzése
  'további számokon végigfut
  For c = 1 To UBound(arraySplit)
  blnHit = False
  i = 1
  Do
  'ha már van ilyen szám, akkor eggyel növeljük a számlálót
  If arraySplit(c) = arrayResult(2, i) Then
  arrayResult(1, i) = arrayResult(1, i) + 1
  blnHit = True
  End If
  i = i + 1
  Loop Until blnHit Or i > UBound(arrayResult, 2)
  'ha még nincs ilyen akkor megjegyezzük a számot
  If Not blnHit Then
  ReDim Preserve arrayResult(1 To 2, UBound(arrayResult, 2) + 1)
  arrayResult(1, UBound(arrayResult, 2)) = 1
  arrayResult(2, UBound(arrayResult, 2)) = arraySplit(c)
  End If
  Next c
  Application.ScreenUpdating = False
  For i = 1 To UBound(arrayResult, 2)
  Cells(ActiveCell.Row, ActiveCell.Column + i) = arrayResult(1, i) & " db - " & arrayResult(2, i)
  Next i
  Application.ScreenUpdating = True
  End If
  
  End Sub

  üdv.

Új hozzászólás Aktív témák