Tiedostossa, olkoon nimi vaikka lauseet, on 2 sarakkeinen taulukko, 1 sarakkeella juokseva numerointi ja saman rivin toisella sarakkeella lause.
Kirjoitan tekstiä, ja tekstin joukkoon pitäisi hakea lause tuolta taulukosta numeron perusteella.
Kirjoitan numeron, painan makron näppäinyhdistelmää tai painiketta;
makro avaa lauseet tiedoston, siirtyy annetun numeron kohdalle, siitä seuraavaan sarakkeeseen, kopioi solun sisällön, sulkee tiedoston, korvaa annetun numeron kopioidulla tekstillä...
Onko mahdollista luoda tuollainen makro ???
Makro-gurut, apua kaivataan !!!
1
680
Vastaukset
olen käyttänyt vastaavaa ohjelmoinnissa. Helppoa laittaa ryhmittäin($) sanomat(lauseet) ja helppo hakea tiedostosta. Tietenkin sen voi tehdä pyytämälläsi tavalla, mutta mielestäni tämä on mukavin ja selkein tapa.
tee tiedosto C:\lauseet.txt" muotoon
$10 'aihe1
kunde testaa1
kunde testaa2
kunde testaa3
$20 'aihe2
kunde testaa11
kunde testaa21
$30 'aihe3
kunde testaa111
kunde testaa211
kunde testaa311
kunde testaa411
kunde testaa511
ja liitä koodi ThisDocument moduuliin...
kysyy aiheen numeron esim. 20 ja sitten rivinumeron esim. 2 ja kirjoittaa aktiiviseen kohtaan tekstin "kunde testaa21"
Dim Aihe As Variant
On Error Resume Next
Aihe = InputBox("Anna aiheen numero")
If Aihe = "" Then Exit Sub
Tekstirivi = InputBox("Anna rivinumero")
If Tekstirivi = "" Then Exit Sub
Selection.TypeText LueTeksti("C:\lauseet.txt", Aihe, Tekstirivi)
End Sub
Function LueTeksti(strTextFile As String, strDollari As Variant, lngTxtLine As Variant) As Variant
Dim dollari As String
Dim Tekstirivi As String
Dim Rivinumero As Long
Dim Dollaritesti As Boolean
Dim Pituus As Long
Dim Tarkistus As Long
Dim Oma As Long
On Error GoTo VIRHE
dollari = "*$" & strDollari & "*"
Open strTextFile For Input As #1
Do While Not EOF(1)
Line Input #1, Tekstirivi
If Tekstirivi Like dollari Then
Dollaritesti = True
Rivinumero = 0
End If
If Dollaritesti = True Then
If Rivinumero = lngTxtLine Then
Oma = InStr(1, Tekstirivi, (Chr(39)))
If Oma > 0 Then
Pituus = Len(Tekstirivi)
Tarkistus = InStr(1, Tekstirivi, (Chr(39)))
If Tarkistus > 0 Then
LueTeksti = Mid(Tekstirivi, 1, (Tarkistus - 2))
If LueTeksti = "False" Or LueTeksti = "True" Then
LueTeksti = CBool(LueTeksti)
Exit Do
ElseIf IsNumeric(LueTeksti) = True Then
LueTeksti = CDbl(LueTeksti)
Exit Do
Else
LueTeksti = CStr(LueTeksti)
Exit Do
End If
End If
ElseIf Oma = 0 Then
LueTeksti = Tekstirivi
If LueTeksti = "False" Or LueTeksti = "True" Then
LueTeksti = CBool(LueTeksti)
Exit Do
ElseIf IsNumeric(LueTeksti) = True Then
LueTeksti = CDbl(LueTeksti)
Exit Do
Else
LueTeksti = CStr(LueTeksti)
Exit Do
End If
End If
End If
Rivinumero = Rivinumero 1
End If
Loop
Close #1
POISTU:
If LueTeksti = Empty Then MsgBox "Annettua riviä ei löydy!!!", vbCritical
Exit Function
VIRHE:
Close #1
MsgBox "Joku meni pieleen!!!", vbCritical
Resume POISTU
End Function
Keep Excelling (Wording)
@Kunde
P.S. seuraavaksi varmaan haluatkin tiedot lomakkeelle, josta klikkaamalla sitten suoraan tekstiin... :-)
Ketjusta on poistettu 0 sääntöjenvastaista viestiä.
Luetuimmat keskustelut
- 796095
Useita puukotettu Tampereella
Mikäs homma tämä nyt taas on? "Useaa henkilöä on puukotettu Tampereen keskustassa kauppakeskus Ratinan lähistöllä." ht2895420Kuka rääkkää eläimiä Puolangalla?
Poliisi ampui toistakymmentä nälkiintynyttä eläintä Puolangalla Tilalta oli ollut karkuteillä lähes viisikymmentä nälkii984111- 522880
- 262722
- 1192060
Meneeköhän sulla
oikeasti pinnan alla yhtä huonosti kuin mulla? Tai yhtä huonosti mutta jollain eri tyylillä? Ei olisi pitänyt jättää sua472020Lähetä terveisesi kaipaamallesi henkilölle
Vauva-palstalta tuttua kaipaamista uudessa ympäristössä. Kaipuu jatkukoon 💘991747- 721291
PS uusimman gallupin rakettimainen nousija
https://yle.fi/a/74-20170641 Aivan ylivoimaisesti suurin kannatuksen nousu PS:lle. Nousu on alkanut ja jatkuu 2 vuoden1591141