Ú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
- Samsung Galaxy Felhasználók OFF topicja
- Okos Otthon / Smart Home
- Videó stream letöltése
- Toomy: FOXPOST: régen jó volt, de már jobban jársz, ha elfelejted
- SONY LCD és LED TV-k
- koxx: Bloons TD5 - Tower Defense játék
- NVIDIA GeForce RTX 5070 / 5070 Ti (GB205 / 203)
- Jövedelem
- Apple asztali gépek
- E-book olvasók
- További aktív témák...
- újszerű iPhone 16 Pro Max 256GB white titanium fehér titán független Apple 2 év garancia ajándék tok
- szinte új 13 hüvelykes MacBook Air M4 512GB SSD midnight éjfekete Apple 3 év garancia
- új aktiválatlan Apple Watch SE 3 GPS 40mm csillagfény alumíniumtok Apple 1 év garancia
- újszerű iPhone Air 256GB sky blue égkék független Apple 1 év garancia
- szinte új Magic Keyboard 11 hüvelykes iPad Pro -hoz (M4 - M5) magyar fehér
- 131 - Lenovo Legion Pro 7 (16IRX9H) - Intel Core i9-14900HX, RTX 4080 (ELKELT)
- Telefon felváráslás!! Xiaomi 13T, Xiaomi 13T Pro, Xiaomi 14T, Xiaomi 14T Pro
- Beszámítás! Acer Predator Helios Neo 16 notebook-i9 14900HX 16GB DDR5 1TB SSD RTX 4060 8GB W11
- HIBÁTLAN iPhone 14 128GB Midnight -1 ÉV GARANCIA - Kártyafüggetlen, MS3527
- 173 - Lenovo Legion Pro 7 (16IAX10H) - Intel Core U9 275HX, RTX 5080 (ELKELT)
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: Laptopműhely Bt.
Város: Budapest

