Hirdetés
- NVIDIA GeForce RTX 5070 / 5070 Ti (GB205 / 203)
- Milyen egeret válasszak?
- Sony MILC fényképezőgépcsalád
- Milyen TV-t vegyek?
- Soundbar, soundplate, hangprojektor
- Milyen széket vegyek?
- RGB-s, LCD-kijelzős VGA-tartó olcsón? Hol kell aláírni?
- Windows 11-hez nyúl az AYANEO értékorientált almárkája
- Milyen nyomtatót vegyek?
- AMD Navi Radeon™ RX 9xxx sorozat
Ú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
- ÚJ BONTATLAN Apple Watch Series SE3 40mm Stairlight Azonnal Átvehető DEÁK TÉRNÉL 1 Év Apple Garancia
- G.SKILL Aegis 16GB (2x8GB) DDR4 3200MHz F4-3200C16D-16GIS új 2 pár
- Lenovo MIIX 520-12IKB, Magyar bill, i5-8250 8Gb ram, 256Gb nvme, számla, garancia 2in1
- SAMSUNG LS32DG800SU ) 240HZ 4K OLED GAMER MONITOR !! AKCIÓ
- SAMSUNG (LS49CG954EUXEN ) 49" 240HZ NEO-QLED DUAL QHD GAMER ! AKCIÓ!!
- Apple iPhone 15 Pro Max 256 GB Natural Titanium 1 év Garancia Beszámítás Házhozszállítás
- ÚJ Razer Kraken V4 Pro gamer fejhallgató
- Bomba Ár! Lenovo ThinkPad E14 G4i - i5-1235U I 16GB I 256SSD I 14" FHD I HDMI I W11 I Gari
- AKCIÓ! Apple iPad Pro 13 2024 M4 16GB/2TB WiFi tablet garanciával hibátlan működéssel
- GYÖNYÖRŰ iPhone XS Max 256GB Black -1 ÉV GARANCIA - Kártyafüggetlen, MS3998, 100% Akkumulátor
Állásajánlatok
Cég: Central PC számítógép és laptop szerviz - Pécs
Város: Pécs
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest


