jak rozdělit čísla oddělené čárkou a pomlčkou?

[atari]

V přioženém souboru mám v buňce A1 čísla oddělená čárkou. Některé jsou oddělené pomlčkou, to znamená rozsah čísel od-do. Potřebuji tyto čísla rozdělit dle vzoru v řádku 3. S těma pomlčkama si nevím rady, má někdo tip jak to vyřešit?
EDIT: v souboru byla chyba, už je opravený

[navstevnik]

Pokud bude struktura retezce obdobna jako v ukazce, pak reseni ve trech krocich pro jednorazove pouziti:
1. Uzivatelskou funkci Transformovat(bunka) transformovat retezec
2. Ctl+C a Upravy>Vlozit jinak>Hodnoty>OK
3. Funkci nabidka Data>Text do sloupcu, separator je "," (carka)

Pro vetsi pocet radku pouzit fci pro kazdy radek a kroky 2 a 3 hromadne.

UDF vloz v edotoru VBA do standardniho modulu:

Kód: Vybrat vše

Option Explicit

Function Transformovat(SCll As Range) As String
  Dim Tmp As String, Zn As String, SStr As String
  Dim i As Integer, j As Long
  Dim ValFrom As Long, ValTo As Long
  SStr = SCll.Value
  Tmp = vbNullString
  For i = 1 To Len(SStr)
    Zn = Mid(SStr, i, 1)
    If IsNumeric(Zn) Then
      Tmp = Tmp & Zn
    ElseIf Zn = "," Then
      Transformovat = Transformovat & Tmp & Zn
      Tmp = vbNullString
    ElseIf Zn = "-" Then
      ' pocatecni hodnota rozvoje rady
      ValFrom = CLng(Tmp)
      Tmp = vbNullString
      ' Transformovat koncovou hodnotu rozvoje rady
      Do
        i = i + 1
        Zn = Mid(SStr, i, 1)
        If Zn = "," Then
          ' koncova hodnota rozvoje rady
          ValTo = CLng(Tmp)
          Tmp = vbNullString
          ' rozvinout radu
          For j = ValFrom To ValTo
            Transformovat = Transformovat & j & Zn
          Next j
          Exit Do
        Else
          Tmp = Tmp & Zn
        End If
      Loop
    End If
  Next i
  Transformovat = Transformovat & Tmp
End Function

Retezec v A1, do cilove bunky: =Transformovat(A1)

[atari]

Super!! Díky moc. Obdivuji rychlost řešení.

[atari]

Tak jsem to dosadil do mých dat, a když je v řádku poslední zápis čísel s pomlčkou: 776-785, tak funkce dává chybu. Bylo by možné to nějak ošetřit? V tom kodu se totiž vůbec nevyznám. Děkuji

[navstevnik]

když je v řádku poslední zápis čísel s pomlčkou: 776-785, tak funkce dává chybu

Taky jsi to mohl uvest do prikladu, neumim cist myslenky.
Co je na procedure (UDF) sloziteho? Ve smycce je prochazen po znacich vstupni retezec, pokud je oddelovac ",", jsou znaky skladany do vystupniho retezce. Pokud je oddelovac "-", je predchozi cast retezce povazovana za pocatecni hodnotu rozvoje rady 776-785 a je hledana koncova hodnota rozvoje po oddelovac "," nebo konec retezce a tehdy je rada rozvinuta a vlozena do vystupniho retezce.
Upravena procedura:

Kód: Vybrat vše

Option Explicit

Function Transformovat(SCll As Range) As String
  Dim Tmp As String, Zn As String, SStr As String
  Dim i As Integer, j As Long
  Dim ValFrom As Long, ValTo As Long
  SStr = SCll.Value
  Tmp = vbNullString
  For i = 1 To Len(SStr)
    Zn = Mid(SStr, i, 1)
    If IsNumeric(Zn) Then
      Tmp = Tmp & Zn
    ElseIf Zn = "," Then
      Transformovat = Transformovat & Tmp & Zn
      Tmp = vbNullString
    ElseIf Zn = "-" Then
      ' pocatecni hodnota rozvoje rady
      ValFrom = CLng(Tmp)
      Tmp = vbNullString
      ' ve smycce nacist koncovou hodnotu rozvoje rady
      Do
        i = i + 1
        Zn = Mid(SStr, i, 1)
        If Zn = "," Or i = Len(SStr) + 1 Then  ' oddelovac nebo konec retezce
          Zn = ","  ' vlozit "," , kdyz je konec retezce je Zn=""
          ' koncova hodnota rozvoje rady
          ValTo = CLng(Tmp)
          Tmp = vbNullString
          ' rozvinout radu
          For j = ValFrom To ValTo
            ' pridat prvek a oddelovac
            Transformovat = Transformovat & j & Zn
          Next j
          Exit Do
        Else  ' znak koncove hodnoty rozvoje
          Tmp = Tmp & Zn
        End If
      Loop
    End If
  Next i
  Transformovat = Transformovat & Tmp
  ' odstranit pripadny oddelovac na konci retezce
  If Right(Transformovat, 1) = "," Then _
      Transformovat = Left(Transformovat, Len(Transformovat) - 1)
End Function

Sub test()
Dim aa As String
aa = Transformovat(ActiveSheet.Range("a1"))
Debug.Print aa
End Sub

[atari]

To se omlouvám, také jsem to nevěděl. Až když jsem to pustil na ostrá data, tak jsem si toho všimnul. Jinak ta procedura obsahuje některé příkazy a způsoby zápisu, které jsou pro mě nové, takže proto se v tom nevyznám. Ještě jednou děkuji

[atari]

Ještě takový nedůležitý dotaz. Jakmile udělám krok 2 a 3 (vložím funkci a data rozdělím do sloupcú), tak mi Excel vloží automatický formát do nesouvisejícího sloupce A (při každém kroku vloží nějaký formát, když smažu sloupec E tak formáty zmizí.. ). Ne, že by mi to nějak vadilo (umim to zrušít) ale překvapuje mě, že si Excel sám něco "vymýšlí". Může to souviset nějak s tou funkcí?
Přikládám vzorek dat.

[navstevnik]

Je to vysledek automaticke formatovani - bohuzel to je bonus Excelu 2007, ktery je v nekterych pripadech otravny, takze zrus , nijak to nesouvisi s UDF.