Hirdetés
- Úgy állhat le a 16 GB-os GeForce RTX 5060 Ti gyártása, hogy közben nem áll le
- Kész, vége, ennyi volt: eladja tévés üzletágát a Sony
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- Gaming notebook topik
- Házimozi belépő szinten
- Házi barkács, gányolás, tákolás, megdöbbentő gépek!
- AMD Navi Radeon™ RX 9xxx sorozat
- Kormányok / autós szimulátorok topikja
- VR topik
- Projektor topic
Ú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
- Kínai és egyéb olcsó órák topikja
- Konteó topic
- Úgy állhat le a 16 GB-os GeForce RTX 5060 Ti gyártása, hogy közben nem áll le
- Arc Raiders
- Kész, vége, ennyi volt: eladja tévés üzletágát a Sony
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- Székesfehérvár és környéke adok-veszek-beszélgetek
- Gaming notebook topik
- Milyen routert?
- exHWSW - Értünk mindenhez IS
- További aktív témák...
- SAMSUNG UE85BU8079 215CM 4K SMART UJ MODELL! AKCIÓ!
- SAMSUNG (QE98QN90FATXZT) 250CM NEO-QLED 165HZ 2025 CSÚCS TV ! AKCIÓ
- SAMSUNG (QE85QN85B) 215CM NEO-QLED SMART PRÉMIUM ! AKCIÓ!
- SAMSUNG (QE85QN80F) 215CM 4K NEO-QLED 144HZ SMART UJ PRÉMIUM ! AKCIŐ
- SAMSUNG (QE77S90CAT) 195CM 4K SMART OLED PRÉMIUM ! AKCIÓ!
- BESZÁMÍTÁS! ASRock B650M R7 7700 32GB DDR5 1TB SSD RX 7900 XTX 24GB Fractal Design Pop Air RGB 850W
- HIBÁTLAN iPhone 11 Pro 64GB Space Grey-1 ÉV GARANCIA - Kártyafüggetlen, MS4329
- új akku Ár/ÉRTÉK BAJNOK! Dell Latitude 5330 i3-1215U 6magos! - 16GB 512GB 13.3" FHD 1 év garancia
- Apple iPhone 14 128GB,Kartyafuggetlen,Újszerű,Dobozaval,12 hónap garanciával
- Tablet felvásárlás!! Apple iPad, iPad Mini, iPad Air, iPad Pro
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Cég: Central PC számítógép és laptop szerviz - Pécs
Város: Pécs


