Hirdetés
- Magga: PLEX: multimédia az egész lakásban
- Yézi: Videokártyáim [2015/08-2026/01]
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- GoodSpeed: Te hány éves vagy?
- Dr. Mózes: Lakberendezési tanácskérés
- Luck Dragon: Asszociációs játék. :)
- potyautas: Felkomf.
- sziku69: Szólánc.
- Luck Dragon: Alza kuponok – aktuális kedvezmények, tippek és tapasztalatok (külön igényre)
- gban: Ingyen kellene, de tegnapra
Új hozzászólás Aktív témák
-
PetX
aktív tag
válasz
martonx
#1154
üzenetére
Már elnézést, de ha neked ez banális probléma akkor sajnálom, nekem nem, ezért fordultam segítségért.
Nem vagyok programozó, kényszerből kezdtem el írni az egészet, mert szükséges ahhoz amit csinálok.
Ehhez a részhez kértem a segítséget:
ActiveWorkbook.Worksheets("SZUMMA").Cells(CS_SOR, CS_OSZLOP) = xSTRSub CSILLAG()
Dim CS_SOR As Integer
Dim OSZLOP As Integer
Dim CS_OSZLOP As Integer
Dim cella As Range
Dim cim_1 As String
Dim cim_2 As String
Dim keres As String
Dim INPUT_STR As String
Dim SPLITTER() As String
Dim xDB As Integer
Dim COUNTNONBLANK As Integer 'file-ok megszámlálásához
Dim MYRANGE As Range 'file-ok megszámlálásához
Dim xSZAMOL As Integer 'az .xml file-ok db számát adja vissza
Dim xSOR As Integer
Dim xREG As String
Dim xSTR As String
'MsgBox ("csillag")
Worksheets.Add().Name = "SZUMMA"
keres = "$$$"
Worksheets("Szamla").Select
OSZLOP = 38
ELORE:
' MENNYISÉG+TOTAL
For i = 0 To 15
Columns(OSZLOP).Select
Set cella = ActiveWorkbook.Worksheets("Szamla").Columns(OSZLOP).Find(what:=keres)
If Not cella Is Nothing Then 'ha talál akkor
Sheets("Szamla").Select
cella.Activate 'akkor aktiválja a cellát
cim_1 = ActiveCell.Address
While Not cim_1 = cim_2
Set cella = ActiveWorkbook.Worksheets("Szamla").Columns(OSZLOP).FindNext(cella)
cella.Activate
cim_2 = ActiveCell.Address
CS_OSZLOP = ActiveCell.Column
CS_SOR = ActiveCell.Row
INPUT_STR = Cells(CS_SOR, CS_OSZLOP)
SPLITTER = Split(INPUT_STR, "$$$")
For xDB = LBound(SPLITTER) To UBound(SPLITTER)
If Right(SPLITTER(xDB), 1) = "-" Then 'ha csak egy negatív van a cellában akkor nem bántja
SPLITTER(xDB) = (Replace(SPLITTER(xDB), "-", "")) * -1
SPLITTER(xDB) = Replace(SPLITTER(xDB), ".", ",")
Else
SPLITTER(xDB) = Replace(SPLITTER(xDB), ".", ",")
SPLITTER(xDB) = "+" + SPLITTER(xDB)
End If
xSTR = xSTR + SPLITTER(xDB)
Next xDB
ActiveWorkbook.Worksheets("SZUMMA").Cells(CS_SOR, CS_OSZLOP) = xSTR
xSTR = ""
Wend
Else
End If
OSZLOP = OSZLOP + 7
Next i
If OSZLOP = 150 Then
OSZLOP = 42
GoTo ELORE
Else
If OSZLOP = 154 Then
OSZLOP = 43
Else
End If
End If
'EGYSÉGÁR
For j = 0 To 15
Columns(OSZLOP).Select
Set cella = ActiveWorkbook.Worksheets("Szamla").Columns(OSZLOP).Find(what:=keres)
If Not cella Is Nothing Then 'ha talál akkor
Sheets("Szamla").Select
cella.Activate 'akkor aktiválja a cellát
cim_1 = ActiveCell.Address
While Not cim_1 = cim_2
Set cella = ActiveWorkbook.Worksheets("Szamla").Columns(OSZLOP).FindNext(cella)
cella.Activate
cim_2 = ActiveCell.Address
CS_OSZLOP = ActiveCell.Column
CS_SOR = ActiveCell.Row
INPUT_STR = Cells(CS_SOR, CS_OSZLOP)
SPLITTER = Split(INPUT_STR, "$$$")
' For xDB = LBound(SPLITTER) To UBound(SPLITTER)
'Sheets("SZUMMA").Select
xDB = 0
ActiveWorkbook.Worksheets("SZUMMA").Cells(CS_SOR, CS_OSZLOP) = SPLITTER(xDB)
' Next xDB
Wend
Else
End If
OSZLOP = OSZLOP + 7
Next j
MsgBox ("kész")
End Sub
Új hozzászólás Aktív témák
Hirdetés
- Apple iPhone 14 Pro Max 256GB, Kártyafüggetlen, 1 Év Garanciával
- Thin GF63 12UC 15.6" FHD IPS i5-12450H RTX 3050 16GB 512GB NVMe magyar vbill gar
- BONTATLAN iPhone 17 Black, 256gb, 3 év gyártói garanciával, eladó!
- Xiaomi 15T Pro 12GB/256GB Mocha Gold használt, karcmentes 6 hónap garancia
- KINGSTON FURY 16GB Beast DDR5 5200MHz CL40 KF552C40BB-16
- Telefon felvásárlás!! Xiaomi Redmi Note 13, Xiaomi Redmi Note 13 Pro, Xiaomi Redmi Note 13 Pro+
- BESZÁMÍTÁS! Gigabyte B760M i5 14600K 16GB DDR4 512GB SSD RX 9060 XT 16GB Asus A31 PLUS TG ARGB 650W
- ÁRGARANCIA!Épített KomPhone i5 14400F 32/64GB DDR5 RTX 5060 Ti 8GB GAMER PC termékbeszámítással
- AZONNALI SZÁLLÍTÁS Eredeti Microsoft Office 2019 Professional Plus
- Bialetti kézi kávéőrlő
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Cég: Laptopszaki Kft.
Város: Budapest

