Hirdetés
- Mi nincs, grafén akku van: itt a Xiaomi 11T és 11T Pro
- Poco F7 – bajnokesélyes
- Amazfit Active 2 NFC - jó kör
- Samsung Galaxy A54 - türelemjáték
- A piac legerősebb kameráját ígéri a Xiaomi 17 Ultra
- Apple iPhone 16 - ígéretek földje
- Xiaomi 15T Pro - a téma nincs lezárva
- Örömkönnyek és üres kezek a TriFold startjánál
- Google Pixel topik
- Xiaomi Mi 8 - így csinálunk csúcsmodellt Mi
Ú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:
Sub 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 = 38ELORE:
' MENNYISÉG+TOTALFor 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.RowINPUT_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 IfOSZLOP = OSZLOP + 7
Next iIf 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.RowINPUT_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 IfOSZLOP = OSZLOP + 7
Next j
MsgBox ("kész")
End Sub
Új hozzászólás Aktív témák
- Mi nincs, grafén akku van: itt a Xiaomi 11T és 11T Pro
- sziku69: Fűzzük össze a szavakat :)
- Teljes verziós játékok letöltése ingyen
- Pánik a memóriapiacon
- Luck Dragon: MárkaLánc
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- Autós topik
- PayPal
- Vigneau interaktív lokálblogja
- Poco F7 – bajnokesélyes
- További aktív témák...
- Philips Lattego EP5345 Szervizelve I Megkímélt állapot I Tejes kancsó I Garancia I Beszámítás
- 100% Akku - Makulátlan új állapot 128 GB (Graphite) és 256 GB (Sierra Blue)
- Apple Macbook Pro 13" a1708 2017 (I5/8GB/256GB)
- Szuper Akciós Ajánlat! Eredeti gyári Asus Rog és Rog Phone gamer kiegészítők új állapotban!
- Samsung S22+ 256 GB eladó (fekete)
- BESZÁMÍTÁS! ASROCK H510M i5 11400F 16GB DDR4 1TB SSD RX 7600 8GB Zalman S2 TG Cooler Master 650W
- KÉSZLETKISÖPRÉSI KARÁCSONYI ULTRAAKCIÓ! - MacBook Air M4 16GB 256GB Garancia!
- Netatmo Presence okos kültéri kamera / 12 hó jótállás
- GYÖNYÖRŰ iPhone 13 256GB Midnight -1 ÉV GARANCIA -Kártyafüggetlen, MS3650
- Telefon felvásárlás!! Apple Watch SE/Apple Watch SE 2 (2022)
Állásajánlatok
Cég: Laptopszaki Kft.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest


