Új hozzászólás Aktív témák
-
Boolash
aktív tag
válasz
Boolash #1072 üzenetére
Nemnagyon pörög a topik
Sikerült előrejutnom. Márcsak 1 probléma van, hátha valaki tudja.
a Selection.Find -nál szeretnék wildchardokat használni kereséshez. Engedélyeztem is a használatukat. Amit szeretnék keresni: [space]bármi[kukac]bármi[.]bármi[space]
ezt kellene lefordítani. De ez így nem jó: <[ ]*[@]*[.]*[ ]> egyrészt mert a @ is jelent valamit, meg a space-t sem kezeli így....
Hogy kellene?
Köszi -
Boolash
aktív tag
word-ben írom, de hivatkozok excel-re is. Tehát itt jelen esetben a wordben megtalált @ -t egy excel munkafüzetbe dobálja.
Amúgy itt tartok:Sub akarmi()
Dim Obj1 As Object
Set Obj1 = CreateObject("excel.application")
Obj1.Visible = True
Obj1.Workbooks.Add
Do Until ActiveDocument.Bookmarks("\Sel") = _
ActiveDocument.Bookmarks("\EndOfDoc")
With Selection.Find
.Forward = True
.Wrap = wdFindStop
.Text = "@"
.Execute
End With
Dim i As Integer
i = 1 + i
Dim valtozoword As String
valtozoword = Selection.Text
'MsgBox valtozoword
'Dim i As Integer
'If i < 25 Then i = 1 + i 'itt i-nek annyinak kéne lenni, mint ahány @ van
Dim excelmezo As String
'MsgBox excelmezo
Obj1.Worksheets("Munka1").Cells(i, 1).Value = valtozoword
Loop
ActiveDocument.Save
End SubEz így végigkeresi az összeset a wordben, és bedobja az excelbe, a cellákba szépen egymás alá.
Az az egyik baj, hogy ez így végtelen... Miért nem száll ki a Loop-ból?? Többször végigmegy a kereséssel az egész word dokumentumon, és így végtelen számút talál és rak be az excelbe....
Köszi -
Boolash
aktív tag
Ebben mi lehet a hiba?
Elméletileg azt csinálná, hogy körbeszalad a word dokumentumon, kikeresi a @-ot, majd ha talál azt egy új excelbe belepakolja (max100-at). Majd menti.Sub akarmi()
Dim Obj1 As Object
Set Obj1 = CreateObject("excel.application")
Obj1.Visible = True
Obj1.Workbooks.Add
Do Until ActiveDocument.Bookmarks("\Sel") = _
ActiveDocument.Bookmarks("\EndOfDoc")
With Selection.Find
.Forward = True
.Wrap = wdFindStop
.Text = "@"
.Execute
End With
Dim i As Integer
If i < 100 Then
i = 1 + i
Selection.Copy
Obj1.Worksheets("Munka1").Cells(1, i).Value = ActiveDocument.Selection
Loop
ActiveDocument.Save
End SubÍgy azt dobja, hogy Loop, without Do. Szerintem több hina is lesz. pl.: Obj1.Worksheets("Munka1").Cells(1, i).Value = ActiveDocument.Selection
Hogy lehetne ezeket?
Köszi -
Boolash
aktív tag
Sziasztok!
Egy gyors segítség jól jönne! Word-ben programozok, és elakadtam (elég hamar...) Azt szeretném kérdezni, hogy hogyan kell egy teljes szót kijelölni? Konrétan arról lenne szó, hogy rákeresek egy betüre a teljes word dokumentumban, majd az kellene nekem, hogy ne csak az a betü legyen kijelölve, hanem az egész szó!Set myrange = ActiveDocument.Content
myrange.Find.ClearFormatting
With Selection.Find
.Text = "@"
.Forward = True
End With
Selection.Find.Execute
End SubIlletve ez így ugyebár, ha megtalálta az első egyezőt, akkor leáll. Gondolom egy if -el nézem azt, hogy a myrange végére ért e. Hogy mondom neki, hogy végére ért e?
Köszi! -
Boolash
aktív tag
válasz
[HUN]Zolee #1016 üzenetére
Okés, megvan minden! Köszi!
Egyébként: ActiveCell.SpecialCells(xlLastCell).Select -
Boolash
aktív tag
válasz
[HUN]Zolee #1014 üzenetére
Áhh.. Megvan..
Kicsit túllőttem a célon... Sok volt az 1000 oszlop.
Esetleg azt nem tudod, hogy hogy lehet megnézni, hogy az adott sorban/oszlopban hol van az utolsó elem? Ne kellejen feleslegesen hiába végignézni sok-sok cellát...
Köszi! -
Boolash
aktív tag
Sziasztok!
Fontos lenne!
Ezzel mi lehet a hiba?Sub elso()
Dim i, j As Integer
For i = 1 To 65536
For j = 1 To 1000
If Munka1.Cells(i, j).Value = Munka2.Cells(i, j).Value Then
Else
Munka1.Cells(i, j).Interior.ColorIndex = 27
End If
Next j, i
End SubEz a sor nem jó: If Munka1.Cells(i, j).Value = Munka2.Cells(i, j).Value Then
merthogy application/object defined error....
De miért?
Hogy kellene?Egyébként azt csinálja, hogy 2 munkalapot összehasonlít, és ahol különbözik a kettő, azt sárgával megjelöli.
Köszi!
Új hozzászólás Aktív témák
Hirdetés
- Magga: PLEX: multimédia az egész lakásban
- NVIDIA GeForce RTX 5080 / 5090 (GB203 / 202)
- Hosszabb bemutatót kapott a Borderlands 4
- Genshin Impact (PC, PS4, Android, iOS)
- Windows Insider Program
- Autós topik
- Nagyrobogósok baráti topikja
- Milyen okostelefont vegyek?
- AMD Radeon™ RX 470 / 480 és RX 570 / 580 / 590
- Mibe tegyem a megtakarításaimat?
- További aktív témák...
- BONTATLAN Új Iphone 16 PRO 128Gb - 1TB Független 1év Apple GARANCIA Deák Térnél Azonnal Átvehető.
- Új Bontatlan Mac Studio M4 Max 2025 14cCPU /32cGPU / 36GB RAM / 512GB SSD - Azonnal Átvehető Deák.
- BONTATLAN Új Iphone 16e 128-512GB 1év APPLE garancia gyári független Deák AZONNAL Átvehető Deák térn
- ÚJ bontatlan S9 45mm Silver Stainless steel Cellular milanese fémszíj 199.900 azonnal átvehető Deák
- ÚJ kipróbálásra felbontott MacBook Pro 16 M4 Pro 14CPU/20GPU 24GB/512GB SSD Magyar billentyűzet Azon
- A Panasonic Toughbook CF-54 i5-5300u i5-6300u TN, IPS touch Budapest, MPL Foxpost
- Tablet felvásárlás!! Apple iPad, iPad Mini, iPad Air, iPad Pro
- ÁRGARANCIA!Épített KomPhone i3 10105F 16/32/64GB RAM RTX 3050 6GB GAMER PC termékbeszámítással
- ÁRGARANCIA!Épített KomPhone Ryzen 7 5700X 16/32/64GB RAM RTX 3060 12GB GAMER PC termékbeszámítással
- BESZÁMÍTÁS!Gigabyte B650M R7 7800X3D 64GB DDR5 1TB SSD RTX 3080Ti 12GB Corsair 4000D Airflow TG 750W
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest