- Xiaomi 15 - kicsi telefon nagy energiával
- Samsung Galaxy S25 - végre van kicsi!
- One mobilszolgáltatások
- iPhone topik
- Garmin Venu X1 - vékony, virtuóz, váltságíjas
- Motorola Edge 50 Neo - az egyensúly gyengesége
- Samsung Galaxy Watch7 - kötelező kör
- Android alkalmazások - szoftver kibeszélő topik
- Samsung Galaxy Watch6 Classic - tekerd!
- Google Pixel topik
Hirdetés
Köszönjük a sok biztatást, támogatást! Egy rövid ideig még féláron tudsz hirdetni, előfizetni!
-
Mobilarena
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
Fferi50
Topikgazda
Szia!
"a Match-ben a Lookup_array Range-re tudok valahogy dinamikusan hivatkozni, mint ahogy a Lookup_value-nál tettem?"
Természetesen, pl. változóként definiálod az adott területet és azt írod be:
Dim kereshely as Rangeset kereshely=Range("N:N")
hol = Application.Match(Cells(sor, "A") & Cells(sor, "B"),kereshely, 0)
A tartomány beállítását pedig szerintem már meg tudod oldani.Üdv.
-
Delila_1
veterán
Egyszerűbb egy új létrehozása a tegnapi és mai táblázatokból. Nem Változtak, hanem aktuális lesz a neve.
-
Delila_1
veterán
Éppen ilyen kérdésre válaszolt FFeri az index fórumon a 29264-es hsz-ben.
-
Fferi50
Topikgazda
Szia!
Bocsi, lehet, hogy nem követtem elég figyelmesen a témát. Hol van a makróban, hogy átnevezi a fájlt?
Mert én csak azt látom, hogy megnyitja a fájlokat, a sheets(1)-ben kicseréli amit kell, majd visszamenti a fájlt.Ennek nem lenne szabad problémát okozni - kivéve, ha angol az op rendszered, de akkor már az eredeti névben sem lehetne szerintem ékezetes betű - , hiszen csak mentés van és nem átnevezés.
Üdv.
-
Delila_1
veterán
Ilyenkor kell lekérdezni a kódját. Beírod az Ű-t egy cellába, és a KÓD függvénnyel hivatkozol erre a cellára.
=kód(a1)Értékként 219-et kapsz. A makróban a csere így módosul:
Cells.Replace What:="körte", Replacement:=Chr(219) & "valami", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=FalseFájlnévben nem érdemes ékezetes betűket alkalmazni.
-
Delila_1
veterán
Az a füzet, mivel makrót tartalmaz, xlsm kiterjesztésű, annak az egynek nyitva kell lennie, hiszen abból indítod a makrót. A többi xlsx kiterjesztésű, azokat nyitja meg sorban.
A többi első lapján kicseréli a szövegeket, most már kipróbáltam. Lehet, hogy nem az első lapon kel csere-berélni?
-
Delila_1
veterán
Próba nélkül!
Sub Csere()
Dim utvonal As String, FN As String
Application.DisplayAlerts = False
utvonal = "F:\Eadat\" '*****
FN = Dir(utvonal & "*.xlsx")
Do While FN <> ""
Workbooks.Open utvonal & FN
Sheets(1).Select '*****
Cells.Replace What:="régi szöveg", Replacement:="új szöveg", LookAt:=xlPart, _ '*****
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveWindow.Save
ActiveWindow.Close
FN = Dir()
Loop
Application.DisplayAlerts = True
End SubA makró az utvonal változóban megadott mappából sorban megnyitja az ott lévő, *.xlsx kiterjesztésű füzetet.
A Sheets(1).Select sor ráállítja a füzetben lévő első lapra.
A cserét az ezután következő, 3 soros utasítás végzi el, majd a megnyitott füzetet menti és bezárja.Három helyre tettem csillagokat, ahol az útvonalat, a megnyitott füzet első lapját, és a "mit cseréljen mire" szövegeket kell megváltoztatnod.
A makrót léptetve próbáld ki 2 füzeten – VB szerkesztőben F8-cal léptetve, majd leállítva. Ha megfelel, a makró elejére beszúrhatsz egy sort, ami leállítja a képernyőfrissítést, ezzel gyorsítva a futást.
Application.ScreenUpdating = False
A makró végén ezt vissza kell állítani.
Application.ScreenUpdating = True
-
Delila_1
veterán
A2-től lefelé vannak a megnevezések, B2-től mellettük az adatok.
D1-től jobbra bevittem a keresendő megnevezéseket, ezek alá írja a makró a találatokat. A példád szerintD1 -> barack
D2 -> őszi
D3 -> kajsziE1 -> alma
E2 -> piros
E3 -> zöldSub kigyűjt()
Dim oszlop As Integer, usor As Long, uoszlop As Integer
uoszlop = Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(2, "D"), Cells(400000, uoszlop)) = ""
Range("A1").Select
For oszlop = 4 To uoszlop
Selection.AutoFilter Field:=1, Criteria1:=Cells(1, oszlop)
usor = Range("B" & Rows.Count).End(xlUp).Row
Range("B2:B" & usor).Select
Selection.Copy Cells(2, oszlop)
Next
Selection.AutoFilter
End SubÍrhatsz bele képernyőfrissítés tiltást-, engedélyezést.
-
Fferi50
Topikgazda
Szia!
A makróban is használhatod és nagyon jól működik a szűrés.
Másrészt viszont kereshetsz a range.find metódussal, nézd meg a példát a VBA helpben.
Használhatod match munkalapfüggvényt makróban is, ami a keresett érték helyét adja meg az adott sorban, vagy oszlopban.Ha egy rövid mintát felteszel, akkor még többet tudunk segíteni.
Üdv.
-
Oly
őstag
Most már csak a kalapos betűk szívatnak.:
Function MAGYARIT(cella As String)
cella = Replace(cella, "é", "e")
cella = Replace(cella, "á", "a")
cella = Replace(cella, "ű", "u")
cella = Replace(cella, "ő", "o")
cella = Replace(cella, "ú", "u")
cella = Replace(cella, "ö", "o")
cella = Replace(cella, "ü", "u")
cella = Replace(cella, "ó", "o")
cella = Replace(cella, "É", "E")
cella = Replace(cella, "Á", "A")
cella = Replace(cella, "Ű", "U")
cella = Replace(cella, "Ő", "O")
cella = Replace(cella, "Ú", "U")
cella = Replace(cella, "Ö", "O")
cella = Replace(cella, "Ü", "U")
cella = Replace(cella, "Ó", "O")
MAGYARIT = cella
End FunctionHa beírom az Ű és Ő betűt, akkor a hullámos vagy kalapos ékezet kerül oda a VBA editorban.
Ezzel lehet kezdeni valamit? -
Mutt
senior tag
Hello,
Nem aktuális már, de ezért még jól jöhet.
Sub CreateCsv()
Const sorok = 2000 'ennyi soronként szabdalunk
Const utvonal = "c:\Temp\" 'ide mentunk
Dim FileNum As Integer
Dim DestFile As String
Dim vLastRow As Long
Dim c As Long, i As Long, j As Long
Dim ki As String
Const sep = ";" 'a mezők ezzel lesznek elválasztva
Dim formatum As String
'megnézzük hány sorunk van
vLastRow = Range("A" & Rows.Count).End(xlUp).Row
'egy kis csinosítás a fájlban lévő sorszámra, pl. 1 helyett 01-et írunk majd
formatum = String(Len(WorksheetFunction.RoundUp(vLastRow / sorok, 0) & ""), "0")
'változó hogy tudjuk hanyadik fájlt írjuk
c = 1
'változó hogy tudjuk melyik sorban vagyunk
i = 1
Do
DestFile = utvonal & "test" & Format(c, formatum) & ".csv"
FileNum = FreeFile()
'megnyitjuk írásra a fájlt
Open DestFile For Output As #FileNum
Do While i <= sorok * c And i <= vLastRow
'betesszük egy változóba az aktuális sor celláit, a cellák közé a tagolójelet beszúrjuk
ki = ""
For j = 1 To Cells(i, Columns.Count).End(xlToLeft).Column
ki = ki & Cells(i, j) & sep
Next j
'fájlba tesszük a sor tartalmát tagolójellel
Print #FileNum, Left(ki, Len(ki) - Len(sep))
'következő sorra ugrunk
i = i + 1
Loop
'bezárjuk a fájlt
Close FileNum
i = sorok * c + 1
'új fájlra van szükség
c = c + 1
Loop While i <= vLastRow '
End Subüdv
-
Delila_1
veterán
Ha lépésenként futtatod, rájössz, hogy minden sort másol, de felülírja az előzőt.
Csv-kel nem szoktam dolgozni. Beteszek egy rövid makrót, amit majd átalakítasz. Ez az A oszlop adatait másolja át egyenként a B-be, és hozzáfűzi, hogy 1, 2, vagy 3. adatsorról van szó.
For sor = 1 To 9 Step 3
Cells(sor, 2) = Cells(sor, 1) & " 1"
Cells(sor + 1, 2) = Cells(sor + 1, 1) & " 2"
Cells(sor + 2, 2) = Cells(sor + 2, 1) & " 3"
Next -
Delila_1
veterán
A nem publikus adatok helyére írj valami mást, utána tedd ki azt a füzetet, amiben dolgozol.
Most egészen más a kérdésed, mint először. Közben megcsináltam 3 lapra a 3 táblázatot makróval úgy, hogy tudja kezelni az újonnan bevitt neveket, és üzleteket. Ha azzal kezded, amire valójában szükséged van, nem kell 1 feladatnak többször nekiugrani.
Szerk.: nem néztem aprólékosan végig a makródat, de azt látom, hogy a vansor: fölé be kell tenne egy Exit Sub-ot, vagy a vansor: -os és a makesor: -os rész helyét cseréld fel.
-
Delila_1
veterán
Ha bővíteni akarod a táblázatodat (személy, üzlet), akkor nem jó ez az elrendezés, mert a 3 táblázat között nincs hely rá. A személyek számának a bővítéséhez inkább egymás mellett kell lenniük a táblázatoknak, az üzletekéhez pedig egymás alatt. Legjobb lenne külön lapokon elhelyezned a hármat.
Nézd meg Mutt válaszát, ott is az elhelyezés a gond, bővítéskor felülírják egymást.
-
Mutt
senior tag
Hello,
Tisztán képletekkel számolva itt van az én megoldásom.
4 megoldás is lehet, nagyjából a hasznossági sorrendben pedig.
1. Kimutatás (Pivot): előnye, hogy automatikusan bővíti az új nevekkel, üzletekkel a kimutatást. Hátránya nagyon nincs.
2. SZORZATÖSSZEG (Sumproduct): a hosszú képletek miatt a szerkesztése rizikós
3. SZUMHATÖBB (Sumifs): hasonló mint a 2-es opció, csak Excel 2007 vagy újabbal műxik.
4. Adatbázisfüggvények (Dsum): érthetőbb képletek azonban a feltéleket külön ki kell írni.A Pivot kivételével az összes megoldásban ha egy új név/üzlet szerepel, akkor azokat kézzel fel kell venni,
a képletek gond nélkül másolhatóak.üdv.
-
Delila_1
veterán
Két külön makróba írtam az alsó, és a felső táblázat kitöltését, de veheted egybe.
Sub Also()
Dim sor%, oszlop%, sorB%
sorB% = 15
For sor% = 10 To 13
For oszlop% = 2 To 4
If Cells(sor%, oszlop%) > 0 Then
Cells(sorB%, "A") = Date
Cells(sorB%, "B") = Cells(sor%, "A")
Cells(sorB%, "C") = Cells(9, oszlop%)
Cells(sorB%, "D") = Cells(sor%, oszlop%)
sorB% = sorB% + 1
End If
Next
Next
End SubSub Felso()
Dim sor%, usor%, sorB%, oszlopB%, WF As WorksheetFunction
Dim nev$, uzlet$
Set WF = Application.WorksheetFunction
usor% = Cells(Rows.Count, "A").End(xlUp).Row
If Range("A15") >= Range("A1") And Range("A15") <= Range("C1") Then
For sor% = 15 To usor%
nev$ = Cells(sor%, "B")
uzlet$ = Cells(sor%, "C")
sorB% = WF.Match(nev$, Columns(1), 0)
oszlopB% = WF.Match(uzlet$, Rows(3), 0)
Cells(sorB%, oszlopB%) = Cells(sorB%, oszlopB%) + Cells(sor%, "D")
Cells(sorB%, oszlopB% + 1) = Date
Next
End If
End SubA képen szereplő cellák helyéhez igazítottam a makrót. Bár nem látszanak a sor- és oszlopazonosítók, úgy vettem, hogy a kezdő dátum az A1-es cellában van.
-
lappy
őstag
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Sub ChDirNet(szPath As String)
SetCurrentDirectoryA szPath
End Sub
Sub Combine_Workbooks_Select_Files()
Dim MyPath As String
Dim SourceRcount As Long, Fnum As Long
Dim mybook As Workbook, BaseWks As Worksheet
Dim sourceRange As Range, destrange As Range
Dim rnum As Long, CalcMode As Long
Dim SaveDriveDir As String
Dim FName As Variant
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
SaveDriveDir = CurDir
ChDirNet "C:\"
FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", _
MultiSelect:=True)
If IsArray(FName) Then
Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
rnum = 1
For Fnum = LBound(FName) To UBound(FName)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(FName(Fnum))
On Error GoTo 0
If Not mybook Is Nothing Then
On Error Resume Next
With mybook.Worksheets(1)
Set sourceRange = .Range("A1:A25")
End With
If Err.Number > 0 Then
Err.Clear
Set sourceRange = Nothing
Else
If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
Set sourceRange = Nothing
End If
End If
On Error GoTo 0
If Not sourceRange Is Nothing Then
SourceRcount = sourceRange.Rows.Count
If rnum + SourceRcount >= BaseWks.Rows.Count Then
MsgBox "Not enough rows in the sheet. "
BaseWks.Columns.AutoFit
mybook.Close savechanges:=False
GoTo ExitTheSub
Else
Set destrange = BaseWks.Range("A" & rnum)
With sourceRange
Set destrange = destrange. _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value
rnum = rnum + SourceRcount
End If
End If
mybook.Close savechanges:=False
End If
Next Fnum
BaseWks.Columns.AutoFit
End If
ExitTheSub:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
ChDirNet SaveDriveDir
End Sub -
Delila_1
veterán
Sub alma()
Dim sor%, usor%, oszlop%, potsor
usor = Range("A1").End(xlDown).Row: potsor = usor% + 1
For sor% = 1 To usor%
oszlop% = Cells(sor%, 200).End(xlToLeft).Column
Do While oszlop > 2
If oszlop% > 2 Then
Cells(potsor, 1) = Cells(sor%, 1)
Cells(potsor, 2) = Cells(sor%, oszlop)
Cells(sor%, oszlop%) = ""
potsor = potsor + 1: oszlop% = oszlop% - 1
End If
Loop
Next
End Sub -
Ááá, bocsi, hülyeséget írtam...
Szóval az lehet a gond, hogy az m ciklusváltozód olyan értéket vesz fel (man_m), amilyen nevű objektum nincs a userform-on. Valószínűleg a for ciklusod 1-el (vagy többel) tovább szalad, mint kellene. (Ahogy írtad 1-től 30-ig kellene futni a ciklusnak) -
-
Én így oldanám meg ezt a feladatot
Public s As Integer, m As Integer
Sub MySubRoutine(MyIndex_s As Integer, MyIndex_m As Integer, Optional MyValue As Variant, Optional MyString As Variant)
Cells(MyIndex_s + 1, 11).Value = DateValue(Now)
Cells(MyIndex_s + 1, 12).Value = Cells(MyIndex_m + 1, 1).Value
Cells(MyIndex_s + 1, 13).Value = "A"
If Not IsMissing(MyValue) Then Cells(MyIndex_s + 1, 14).Value = MyValue
If Not IsMissing(MyString) Then Cells(MyIndex_s + 1, 15).Value = MyString
End Sub
Sub MyMainCode()
s = s + 1
MySubRoutine s, m, 48
s = s + 1
MySubRoutine s, m, 49
s = s + 1
MySubRoutine s, m, 31, "ID"
s = s + 1
MySubRoutine s, m
End Sub -
-
-
Elég összetett hiba lehet, de pl tipikusan akkor jelentkezik, ha különböző verziójú excel-ben van használva a project, de a fejlesztő nem figyelt (vagy nem tudta), hogy bizonyos függvények/ActiveX vezérlők nem használhatóak ugyanúgy... Pl Office 2010 x64-ben készült, activex vezérlőket is tartalmazó project, dobhat ilyen hibát egy 2007-es Office-ban...
-
-
-
Select all the rows, including the column headers, in the list you want to filter.
Tip
Click the top left cell of the range, and then drag to the bottom right cell.
On the Data menu, point to Filter, and then click Advanced Filter.
In the Advanced Filter dialog box, click Filter the list, in place.
Select the Unique records only check box, and then click OK.The filtered list is displayed and the duplicate rows are hidden.
On the Edit menu, click Office Clipboard.
The Clipboard task pane is displayed.
Make sure the filtered list is still selected, and then click Copy Copy button.
The filtered list is highlighted with bounding outlines and the selection appears as an item at the top of the Clipboard.
On the Data menu, point to Filter, and then click Show All.
The original list is re-displayed.
Press the DELETE key.
The original list is deleted.
In the Clipboard, click on the filtered list item.
The filtered list appears in the same location as the original list.
Nem lehet, hogy az IE-vel kellene megnézni? FF és társai "néha" nem szeretik az MS oldalakat...
-
-
Előbbire nem tudok így hirtelen mit mondani, másodikra viszont igen:
Private Sub CommandButton1_Click()
Dim MyApplication As Object
Set MyApplication = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Kérem válasszon egy mappát...", 0, OpenAt)
On Error Resume Next
MsgBox (MyApplication.self.Path)
On Error GoTo 0
Set MyApplication = Nothing
End Sub -
Akkor miért az Excel topikban kérded? Nagyobb a forgalom gondolom...
Amúgy meg nem bonyolult, beteszem a kódot, hátha másnak jól jön valamikorPrivate Sub CommandButton1_Click()
Dim MyFxs As WorksheetFunction
Dim MySrcRange As Range, MyDestRange As Range
Set MyFxs = Application.WorksheetFunction
Set MySrcRange = Sheets("Munka1").Range("A1")
Set MyDestRange = Sheets("Munka1").Range("A2")
MyDestRange = MyFxs.WorkDay(MySrcRange, 1) + _
TimeSerial(Hour(MySrcRange), Minute(MySrcRange), Second(MySrcRange))
End SubUI: Az Access-el az a "gond", hogy a feltett kérdések egy részéhez az embernek le kell gyártani a táblát, de néha az sem elég, mert több tábla, meg a kapcsolatok stb stb kellenek ahhoz, hogy egyáltalán lehessen segíteni, szóval ilyen esetekben van amikor az egész adatbázis kellene...
-
-
-
Annyit had javasoljak, hogy a Goto utasítást csak akkor használd, ha nincs más. A strukturált nyelvek esetén a Goto 99%-ban nem szükséges.
If Len(Dir(Cells(7, 26))) = 0 Then GoTo dirmakego
GoTo csvmakegoEgy ilyen szerkezet, minden vizsgán (bármely strukturált nyelvről is legyen szó) elégtelen...
(a többiről a kódodban nem is beszélve)
(És hidd el, nem elfogultságból mondom, mivel kb 6 évet Assembly-ben dolgoztam, ott meg csak ugró utasítások vannak)Javaslom nézz utána az If...Else...EndIf struktúrának, mert szörnyen használod jelenleg...
-
perfag
aktív tag
-
Delila_1
veterán
Látom, értékeket illesztettél be a table lapra. Ha ez nem fontos, fel lehet gyorsítani azzal, hogy kihagyjuk a Select-eket.
Sub Masol()
Dim sor%, sor_1%
Sheets("make").Select
sor_1% = 1
For sor% = 1 To 111
If Cells(sor%, 1) > "" Then
Sheets("table").Cells(sor_1%, 1).EntireRow.Insert
Range("A" & sor% & ":I" & sor%).Copy Sheets("table").Cells(sor_1%, 1)
sor_1% = sor_1% + 1
End If
Next
End SubHa mégis az értékek beillesztése kell, holnap megírom.
Szerk.: ez az A1-től másol, az A11-től való másolásnál a For-Next ciklust 11-től kell indítani.
A makródban nem látom a sorok beszúrását (EntireRow.Insert). -
Delila_1
veterán
-
Delila_1
veterán
Feltételezve, hogy a füzetekben, és a gyűjtő füzetben az első sorban megvan a címsor, valamint, hogy az összemásolandó adatok az A oszlopban kezdődnek:
Sub Osszadat()
Dim wbgyujto As Workbook, wb2 As Workbook
Dim utvonal As String, FN As String
Application.ScreenUpdating = False
utvonal = "E:\Temp\"
Set wbgyujto = ActiveWorkbook
FN = Dir$(utvonal & "*.*", vbDirectory)
Do While (Len(FN) > 0)
If Not (FN = "." Or FN = "..") Then
Workbooks.Open Filename:=utvonal & FN
Set wb2 = ActiveWorkbook
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Copy
wb2.Close
Range("A" & ActiveSheet.UsedRange.Rows.Count + 1).Select
ActiveSheet.Paste
End If
FN = Dir$()
Loop
Application.ScreenUpdating = True
Msgbox "Kész az összemásolás"
End SubAz utvonal = "E:\Temp\" sort írd át a saját útvonaladra
-
Deleting All VBA Code In A Project résznél találod
Most nem próbálom ki, de majd írj mire jutottál véle, logikusan ennek az egy makrónak azért meg kellene, hogy maradjon(mármint ami kitörli az összes többit)... -
Hali!
Átlehet, csak ahhoz a Windows API függvények behívására lesz szükség, ami nem biztos hogy teljesen érthető lesz...[link]
Nem csak igen és nem gomb létezik, illetve megerősítés/figyelmeztető ikon is megjeleníthető a msgbox-on stb, ezek kombinációjával mindent meg lehet végül is oldani, amire a gyári gombfeliratokkal lehet válaszolni...De Te tudod...[link]
Fire.
-
Hali!
Bocs, de ma ilyen ufótevékenység van felénk, a PH! elég furcsán viselkedett nálam, ehhez még hozzájött a netszolgáltatóm "remekelése" és már kész is a roppant értelmes hsz.
Na szóval, pl így
.SentOnBehalfOfName = Range("F2")
A másik kérdésedre passz...Annyit tehetsz, hogy nem az értékét(value) tulajdonságát módosítod, hanem a Text tulajdonságát.
Fire.
-
-
-
-
Hali!
Hmm, érdekes gondolat...
Hát az egész excel ablakot nem tudom, hogy elrejteni de a worbook-ot így igen (nem elrejtjük, minimize-re állítjuk)
Megnyitáskor így indíthatod a Formot
Private Sub Workbook_Open()
UserForm1.Show vbModal
End SubEz pedig a UserForm események, az előbbi amikor megnyílik a form, az utóbbi meg amikor bezáródik
Private Sub UserForm_Activate()
On Error Resume Next
With GetObject(, "Excel.Application")
.ActiveWindow.WindowState = xlMinimized
End With
End Sub
Private Sub UserForm_Terminate()
On Error Resume Next
With GetObject(, "Excel.Application")
.ActiveWindow.WindowState = xlMaximized
End WithFire.
-
-
-
Hali!
Kép perfrag linkjéről
Kód
Sub YesNoMessageBox()
Dim Answer As String
Dim MyNote As String
'Place your text here
MyNote = "Do you agree?"
'Display MessageBox
Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "???")
If Answer = vbNo Then
'Code for No button Press
MsgBox "You pressed NO!"
Else
'Code for Yes button Press
MsgBox "You pressed Yes!"
End If
End SubFire.
-
perfag
aktív tag
Itt egy minta VBA: Yes or No Message Box.Erre gondoltál? A MsgBox sorokat kell lecserélned kilépésre, vagy egy makró meghívására.
-
Delila_1
veterán
A lapnév mindig string típusú. A #8005-ben ezért dimenzionáltam.
Dim sheetnev As String
Kipróbáltam, ha a J1-ben van a MA() függvény, bár ott az alapbeállítási formában (2010.08.26) jelenik meg, a létrehozott új lap neve ponttal a végén születik. Újabb futtatásnál a "pontos" lap lesz aktív.
-
Delila_1
veterán
Új hozzászólás Aktív témák
- Autós topik
- Témázgatunk, témázgatunk!? ... avagy mutasd az Android homescreened!
- BMW topik
- Búvárkodás
- Úgy tűnik, nem lesz Samsung Galaxy Tab S10
- Nintendo Switch 2
- Milyen autót vegyek?
- DUNE médialejátszók topicja
- Jelszókezelők 2025-ben: biztonság vagy illúzió?
- Xiaomi 15 - kicsi telefon nagy energiával
- További aktív témák...
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Assassin's Creed Shadows Collector's Edition PC
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap
- BESZÁMÍTÁS! MSI B450M R5 5500 16GB DDR4 512GB SSD RTX 2060 Super 8GB Rampage SHIVA ADATA XPG 600W
- AKCIÓ! 6TB Seagate SkyHawk SATA HDD meghajtó garanciával hibátlan működéssel
- AM 4 alaplapok! Kamatmentes rèszletre is!
- Telefon felvásárlás!! Xiaomi Redmi Note 10, Xiaomi Redmi Note 10s, Xiaomi Redmi Note 10 Pro
- GYÖNYÖRŰ iPhone 11 Pro 256GB Midnight Green -1 ÉV GARANCIA - Kártyafüggetlen, MS2048, 96% Akksi
Állásajánlatok
Cég: FOTC
Város: Budapest