Funcția de căutare este disponibilă din meniul contextual al celulelor:
După cum puteți vedea în screenshot, există posibilitatea de a alege un browser.
Alegerea include cele mai populare browsere: Internet Explorer, Mozilla Firefox, Opera și Google Chrome.
Macro-ul a impus în mod deliberat o limită a numărului de celule, ale căror texte pot fi lansate simultan în căutare.
Dacă numărul de valori unice non-goale din celulele selectate depășește 20, căutarea va fi anulată,
iar utilizatorul va vedea un mesaj de avertizare:
Codul (vezi exemplul din fișierul atașat) constă din 2 macro-uri.
Macro-ul CreateItemsInCellContextMenu pornește automat, de fiecare dată când faceți clic dreapta pe o foaie,
și adaugă elemente noi în meniul contextual al celulei.
Macro-ul SearchValuesInWeb este lansat când faceți clic pe unul dintre elementele adăugate în meniu,
Stabilește ce browser să caute și începe să caute fiecare valoare din intervalul selectat.
O zi bună pentru toți. Am răspândit codul pentru a rula macro-ul din butonul de add-in sau (macro-ul pentru a crea meniul este eliminat).
Sub SearchValuesInWeb ()
Dim Link $
'Macro deschide rezultatele căutării valorilor din celule în browserul selectat
"căutarea se face pe Google
Dacă Err Then Exit Sub 'nu pornește din meniul contextual
maxCellsCount = 10 'mai mult de 20 de celule - refuză începerea căutării
Dim coll As New Collection
"luăm numai valori unice ne-goale din gama selectată de celule
Dim ra Interval: Set ra = Intersect (Selecție, ActiveSheet.UsedRange)
Arr = ra.Value: Dacă ra.Cells.Count = 1 Atunci Arr = Array (ra (1))
Pentru fiecare element în Arr
Dacă Len (Trim (Item)) Apoi coll.Add CStr (Trim (Item)), CStr (Trim (Item))
Dacă coll.Count> maxCellsCount Apoi ieșiți pentru
următor
"Dacă executați în mod accidental o căutare pentru mii de valori - computerul se blochează pentru o lungă perioadă de timp.
Dacă coll.Count> maxCellsCount Apoi
msg = "Numărul de valori de căutare a depășit limita în" maxCellsCount „Celulele!“
MsgBox msg, vbExclamation, "Prea multe valori - căutarea este anulată"
Ieșire Sub
Sfârșit Dacă
"vom forma calea către browserul selectat (este dificil să excizăm informațiile necesare în registru.)
"nu este un fapt că va funcționa pe toate computerele (programele ar putea fi instalate în alte foldere)
Calea $ = "" "" "C: \ Program Files (x86) \ Google \ Chrome \ Application \ chrome.exe" "" ""
"verificați existența fișierului browser executabil
Path2 $ = $ Cale: Dacă Dir (Split (Path $, de CHR (34)) (1), vbNormal) = "" Atunci Path2 $ = ""
Da, poți.
Astfel de decizii fac acum pe baza add-on-urilor "Parser sites"
Bună, dar nu puteți căuta în Google, ci pe un anumit site?
Bine ai venit!
Spuneți-mi dacă este posibilă sincronizarea datei curente prin Internet prin intermediul macro-ului.
Vreau să fixez o limită pentru program la data curentă.
Acum codul arată astfel:
Private Sub Workbook_Open ()
altfel
Foi ("Sheet1") Selectați
ActiveSheet.Cells (1, 1) .Value = 0
unde valoarea celulelor (1, 1) termină programul.
Dar este foarte ușor să te apropii - schimbi doar data în calendarul Windows. Cum sa fii?
Codul nu funcționează cu unele caractere.
Dacă căutarea se bazează pe textul formularului
text1 | Text2
și anume folosind operatorul logic OR
Spune-mi, cu ce ar putea fi vorba? Chiar dacă schimbăm simbolul | pe% 7c - încă nu vreau.
Vă mulțumesc foarte mult pentru resursele dvs. utile.
Am rezolvat problema mea, dar nu știu dacă este corect din punct de vedere tehnic, dar lucrez pentru 100%
Sub CreateItemsInCellContextMenu ()
La reluarea erorii următoare
PopularBrowsers = Array ("hărți 2gis", "hărți Yandex", "Google Maps", "Yandex", "Google")
Application.CommandBars ("celula"). Resetare "meniul de resetare a celulelor
Application.CommandBars ("celula"). Controale (1) .BeginGroup = Avertisment "adevărat" peste primul element din meniu
adăugați elemente în meniul contextual al celulelor
Cu Application.CommandBars ("celula") Controls.Add (10.1)
.Caption = "Căutați pe."
"adăugați sub-elementele din meniu
Pentru fiecare browser din PopularBrowsers 'pentru fiecare browser - elementul de meniu
Cu .Controls.Add (1. 1) 'adăugați elementul din meniu
.OnAction = "SearchValuesInWeb" 'atribui macro-ului butonului SearchValuesInWeb
.Caption = browser. Tag = browser "în proprietatea TAG amintesc numele browserului
Sfârșit cu
următor
Sfârșit cu
End Sub
Sub SearchValuesInWeb ()
'Macro deschide rezultatele căutării valorilor din celule în browserul selectat
"căutarea se face pe Google
Pe eroare Reluați Următorul: Err.Clear
browser $ = Application.CommandBars.ActionControl.Tag "citi parametrul din proprietatea TAG
Dacă Err Then Exit Sub 'nu pornește din meniul contextual
maxCellsCount = 20 'mai mult de 20 de celule - refuză să înceapă căutarea
Dim coll As New Collection
"luăm numai valori unice ne-goale din gama selectată de celule
Dim ra Interval: Set ra = Intersect (Selecție, ActiveSheet.UsedRange)
arr = ra.Value: Dacă ra.Cells.Count = 1 Apoi arr = Array (ra (1))
Pentru fiecare articol În arr
Dacă Len (Trim (Item)) Apoi coll.Add CStr (Trim (Item)), CStr (Trim (Item))
Dacă coll.Count> maxCellsCount Apoi ieșiți pentru
următor
"Dacă executați în mod accidental o căutare pentru mii de valori - computerul se blochează pentru o lungă perioadă de timp.
Dacă coll.Count> maxCellsCount Apoi
msg = "Numărul de valori de căutare a depășit limita în" maxCellsCount „Celulele!“
MsgBox msg, vbExclamation, "Prea multe valori - căutarea este anulată"
Ieșire Sub
Sfârșit Dacă
Dacă este necesar codul de pregătire, puteți întotdeauna să plasați o comandă pentru completarea codului pentru nevoile dvs.
Sau la forumul Excel ați pus această întrebare - probabil ați ajutat deja cu soluția.
Articole similare
Trimiteți-le prietenilor: