Hirdetés
- Drasztikus változást mutat a Sony mobilja az első képeken
- Hatalmas telepet és fizikai ventilátort kaptak az új Oppo-k
- Tizenegyes! A VAR helyett a CAD buktatta le a Google profi játékosát
- Gyorsabb processzort igen, memóriát alig kapott a Xiaomi új HD tévéokosítója
- Ennyit szűkít az X300 Ultra a telepen Európában
- Így lehet kiszúrni, ha kamu AirPods fülest akarnak eladni neked
- One mobilszolgáltatások
- Samsung Galaxy S26 - szeret, nem szeret
- Motorola Edge 40 - jó bőr
- Yettel topik
- iPhone topik
- Honor Magic8 Pro - bevált recept kölcsönvett hozzávalókkal
- Ennyit szűkít az X300 Ultra a telepen Európában
- Milyen okostelefont vegyek?
- Szívós, szép és kitartó az új OnePlus óra
Ú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
- Gyúrósok ide!
- Doky586: Windows telepítés utáni beállítások
- Rezsicsökkentés, spórolás (fűtés, szigetelés, stb.)
- E-roller topik
- Fortnite - Battle Royale & Save the World (PC, XO, PS4, Switch, Mobil)
- Futás, futópályák
- One otthoni szolgáltatások (TV, internet, telefon)
- Hivatalosan is elkezd védekezni az Intel csodafegyvere ellen az új Geekbench
- Witcher topik
- Óvodások homokozója
- További aktív témák...
- Magyar menüs Saeco Picobaristo OTC tejtartállyal
- ASUS ROG Zephyrus GA503QM / Ryzen 7 5800HS / 32GB RAM / 1TB SSD / RTX 3060 / 15,6 WQHD 165Hz
- Samsung Galaxy S25 Ultra 256GB, Kártyafüggetlen, 1 Év Garanciával
- Apple iPhone 11 Pro 64GB, Kártyafüggetlen, 1 Év Garanciával
- Arctic Gamer - Intel Xeon E5-2630 V4 / RX 480 8GB Nitro+ / 16GB DDR4 / 512GB Nvme - VADI ÚJ GÉP
- Kuriózum: Ozark Trail (amerikai) fejlámpa 600 lumen
- SÁRGA! -20%!!! MACBOOK NEO!!!! - MAGYAR BILLES! - CITRUS AJÁNDÉKKAL!
- Nvidia Quadro és AMD FirePro kártyák - számla, 6 hó gar.
- HP EliteOne 800 G6 All-in-One i5-10500 32GB 1000GB 24" Érintőkijelző!! 1 év garancia
- AZONNALI SZÁLLÍTÁSSAL Eladó Windows 8 / 8.1 Pro
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest

