Kysymyksessä pitkä kaksi sarakkeinen taulukko sisällöltään esim:
1 1,7
2 3
2
3 2,5
4 4,2
5 1,9
5
6 2,1
Nyt olisi tarvis saada taulukosta sellainen, että vasen sarake olisi järjestysnumeroiltaan nouseva (eli ylimääräiset 2, 5 jne rivit poistuvat)ja oikeanpuoleisesta sarakkeesta häviävät tyhjät solut, jolloin lopputulos olisi seuraava:
1 1,7
2 3
3 2,5
4 4,2
5 1,9
6 2,1
...
Jos vasemmanpuoleisessa sarakkeessa kaksi tai useampia samaa numeroa allekkain, niin oikeanpuoleisessa sarakkeessa on aina tyhjää näillä kohdin eli yhtä järjestysnumeroa vastaa alkuperäisessäkin taulukossa vain yksi luku.
Kiitos!
1 1,7
2 3
2
3 2,5
4 4,2
5 1,9
5
6 2,1
Nyt olisi tarvis saada taulukosta sellainen, että vasen sarake olisi järjestysnumeroiltaan nouseva (eli ylimääräiset 2, 5 jne rivit poistuvat)ja oikeanpuoleisesta sarakkeesta häviävät tyhjät solut, jolloin lopputulos olisi seuraava:
1 1,7
2 3
3 2,5
4 4,2
5 1,9
6 2,1
...
Jos vasemmanpuoleisessa sarakkeessa kaksi tai useampia samaa numeroa allekkain, niin oikeanpuoleisessa sarakkeessa on aina tyhjää näillä kohdin eli yhtä järjestysnumeroa vastaa alkuperäisessäkin taulukossa vain yksi luku.
Kiitos!
Vastaukset 2
Vanhimmat
Sanotaanko tästä vaikka näin, että poimi haluamasi, mutta jos et saa selvää niin sillehän minä en mitään voi;
If strExcelXls "" Then
Set Edf = CreateObject("Excel.Application")
With Edf
If Check2.Value = 1 Then
.Visible = True
End If
.Workbooks.Open strExcelXls
' Tekstiä soluun. Soluun I21 tulee asiakirjan
' tekstiosuus (alenevasti)
.Worksheets("Taul1").Activate
.Worksheets("Taul1").Range("I21", "L21").ClearContents
Dim strOsaKorv As String
Dim iPitu As Integer
iPitu = 21
Do Until Right(strOsaKorv, 1) = vbCr Or Right(strOsaKorv, 1) = vbCrLf Or iPitu >= 44 And strOsaTieto ""
strOsaKorv = strOsaKorv & Left(strOsaTieto, 1)
If Right(strOsaKorv, 1) = vbCr Then
strOsaKorv = ""
iPitu = iPitu 1
End If
If Right(strOsaKorv, 2) = vbCrLf Then
strOsaKorv = ""
iPitu = iPitu 1
End If
If Left(strOsaKorv, 1) = vbTab Then
strOsaKorv = Left(strOsaKorv, Len(strOsaKorv) - 1)
End If
If Right(strOsaKorv, 1) = vbTab Then
strOsaKorv = Right(strOsaKorv, Len(strOsaKorv) - 1)
End If
If Right(strOsaKorv, 1) = vbLf Then
strOsaKorv = ""
iPitu = iPitu 1
End If
If Left(strOsaKorv, 1) = vbCr Then
strOsaKorv = ""
iPitu = iPitu 1
End If
If Left(strOsaKorv, 1) = vbLf Then
strOsaKorv = ""
iPitu = iPitu 1
End If
' Tässä sijoitetaan teksti oikeaan paikkaan
' ja jokainen rivi erikseen (kun ensin on
' poistettu ylimääräiset merkit)
Range("I" & iPitu, "L" & iPitu).Value = strOsaKorv
If strOsaTieto "" Then
strOsaTieto = Right(strOsaTieto, Len(strOsaTieto) - 1)
End If
If strOsaTieto = "" Then
Exit Do
End If
Loop
.Worksheets("Taul1").Range("O5").ClearContents
.Worksheets("Taul1").Range("O5").Value = Text1.Text
' PVM myös tähän.
.Worksheets("Taul1").Range("O6").ClearContents
.Worksheets("Taul1").Range("O6").Value = Date
' Etu- ja Sukunimi sheettiin
.Worksheets("Taul1").Range("O10", "P10").ClearContents
.Range("O10", "P10").Value = strEtu & " " & strSuku
' PVM sheettiin
.Worksheets("Taul1").Range("O13").ClearContents
.Worksheets("Taul1").Range("O13").Value = Date
' Maksuehto
.Worksheets("Taul1").Range("O14").ClearContents
If Combo1.Text "" Then
.Worksheets("Taul1").Range("O14").Value = Combo1.Text
End If
' Huomautusaika
.Worksheets("Taul1").Range("O15").ClearContents
If Combo2.Text "" Then
.Worksheets("Taul1").Range("O15").Value = Combo2.Text
End If
' Viivästyskorko
.Worksheets("Taul1").Range("O16").ClearContents
If Combo3.Text "" Then
.Worksheets("Taul1").Range("O16").Value = Combo3.Text
End If
' Kehitystä tähän kohti!
' Määrä kappaleissa.
.Worksheets("Taul1").Range("M21").Value = strKPL
' Hinta yksikössä.
.Worksheets("Taul1").Range("P21").Value = strHinta
' Yrityksen nimi ja osoite
' Ensin vanhat pois
.Worksheets("Taul1").Range("H12", "K12").ClearContents
.Worksheets("Taul1").Range("H13", "K13").ClearContents
.Worksheets("Taul1").Range("H14", "K14").ClearContents
' Sitten uudet tilalle.
.Worksheets("Taul1").Range("H12", "K12").Value = strYritys
.Worksheets("Taul1").Range("H13", "K13").Value = strLahios
.Worksheets("Taul1").Range("H14", "K14").Value = strPostiNro
' Hinta eli paljonko pitää maksaa!
.Worksheets("Taul1").Range("P47").ClearContents
.Worksheets("Taul1").Range("P47").Value = strHinta
' Tallennetaan tiedostonimellä (ei tallenna
' makroja)
' .SaveWorkspace strFile
' Tallentaa myös makrot mukana.
.CopyObjectsWithCells = True
.ActiveWorkbook.SaveAs strFile
' Suljetaan työkirjat
.Workbooks.Close
' Ja lopetetaan ohjelma (Application)
.Quit
End With
If Check2.Value = 1 Then
Set Edf = Nothing
Set Edf = CreateObject("Excel.Application")
With Edf
.Workbooks.Open strFile
.Worksheets("Taul1").Activate
.Visible = True
End With
End If
'Set Edf = Nothing
lblSave.FontBold = True
lblSave.Caption = "Katso: " & strFile
End If ' If strExcelXls "" Then
Eikö ole helpointa ottaa Pikasuodatus, ja suodattaa vain ne rivit, joissa 2. sarakkeen arvo on suurempi kuin 0?