kunde
Isaan Rules WFF CCC
If you walked away smiling-then for you the price was right
Keep Exceling
Suosikkibändit/artistit: Queen, Rammstein, genesis, Bruce Bringsteen, Kino, Mandref Mann Earth band Who
Lempikirjat: ohjelmointi...
Suosikkipalstat Suomi24 Keskusteluissa: EXCEL, Kivitalot, EPS
En pidä: pakkanen ja loskakelit
Ruoka & juoma: loimulohi ja valkkari
Linkit: http://www.kundepuu.com, Khorat
Koulutus: ---
Ammatti: Tiede/teknologia
Työskentelen: freelancer
Ase tai siviilipalvelus: yliluutnantti
Siviilisääty: Varattu
Lapset: ---
Hakusanat: Thaimaa, korat, Excel, VBA, ACAD, CNC, Polyurea, EPS, MgO elementti
Liittynyt sitten
Muokkaa profiilia7 aloitusta · 1377 kommenttia
- höpö höpö...
ei tartte tallentaa ennen makron suorittamista
muuta taulukon nimi sopivaksi
Sub TallennaPDF()
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\Kunde\Desktop\" & Worksheets("Taul1").Range("B1") & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End Sub
Keep EXCELing
@Kunde - tarkoitat varmaan tätät koodia?
Function SivunNimi(n)
SivunNimi = Sheets(n).Name
End Function
se ei päivity ja ongelma myös siinä, jos siirrät taulukkoa palauttaa väärän taulukon nimen. Ainoat keinot on APi ja toi allaoleva koodini, jotka palauttavat oikean taulukon siirtelee sitä tai ei.
tämä päivittyy
Function SivunNimi(n)
Application. Volatile
SivunNimi = Sheets(n).Name
End Function
Keep EXCELing
@Kunde - Sub koe2()
Dim Solu As Range
Dim i As Long
i = 1
With Worksheets("Taul2")
.Range("A:A") = ""
For Each Solu In Worksheets("Taul1").Range("A1:A10")
If Not Solu.Offset(0, 1) = "" Then
.Range("A" & i).Resize(Solu.Offset(0, 1)) = Solu
i = i Solu.Offset(0, 1)
End If
Next
End With
End Sub
keep EXCELing
@Kunde - ehdollinen muotoilu
esim. jos B-sarakkeessa vaikka osoite, niin kaavaksi
=NOT(B1=Sheet1!B1)
muuta taulukon nimi sopivaksi - logiikalla...
=(A1<1980)*1 (A1<=1990)*(A1>=1980)*2 (A1>1990)*3 - ei tarvitse määritellä aluetta...
Sub Piilota()
ActiveCell.EntireRow.SpecialCells(xlCellTypeBlanks).EntireColumn.Hidden = True
End Sub
Sub Näytä()
ActiveCell.EntireRow.SpecialCells(xlCellTypeBlanks).EntireColumn.Hidden = False
End Sub
Keep EXCELing
@Kunde - Sub TAulukonNimet()
Dim i As Long
For i = 1 To Sheets.Count
Cells(i, 1) = Sheets(i).Name
Cells(i, 2) = Worksheets(i).Range("C1")
Next i
End Sub
Kep EXCELing
@Kunde - koodilla mahdollisuuksia kikkailla lisää
hiiren oikea, tuplaklikkaus ja solun aktivointi ja valintalomake usealle linkille nyt ainakin onnistuu...
Keep EXCELing
@Kunde - Jos hiiren oikealla klikkaa solua , niin siihen aukeavaan valikkoon voi koodilla lisätä tekstiä ja liittää makroja tekstiin ja eri soluissa voisi olla vaikka eri linkit ja useitakin linkkejä
kommenttiin voi liittää 1 linkin, mutta kommentti pitää olla näkyvillä kokoajan
Kopioimalla tekstin jostakin solusta kuvana ja liittämällä se soluun ja siihen sitten hyperlinkin onnistuu samaan tapaan kuin edellisissä postauksissa on kerrottu
Keep EXELing
@Kunde - Tools valikosta tarkista onko Require Variable Declaration valittuna. Helpottaa ainakin nimien väärinkirjoittamisen tarkistuksessa.
En tiedä onko haittaa, jos poistat täpän Auto Systax Checkistä. Ainakin voisi kuvitella auttavan
Luulen, että syynä sulla tupla välilyöntejä ja muita kirjoitusvirheitä kirjoittaessa ja kun ohjelma aika ajoin tekee auto tarkistuksia ja poistaa tupla välilyöntejä yms. jolloin kursori saattaa siirtyä. Ei ole itsellä tullut tommosta esille.
Keep EXCELing
@Kunde - Huonosti luin ...
Sulla olikin siis kaava soluissa, joka muuttuu. Muutin nyt alueeksi A1:A100, jolla tekee muutokset....
helppo fiksata tota solualuetta
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Solu As Range
For Each Solu In Range("A1:A100")
If Not Solu.Value Like "*[!0-9]*" Then
Solu.NumberFormat = "General"
ElseIf Not Solu.Value Like "*[!0-9,]*" And Not Solu.Value Like "*,*,*" Then
Solu.NumberFormat = "0.0000"
Else
Solu.NumberFormat = "General"
End If
Next
End Sub
Keep EXCELing
@Kunde - ko. taulukon moduuliin...
muuta solualue sopivaksi nyt A -sarake
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Solu As Range
For Each Solu In Intersect(Target, Columns("A"))
If Not Solu.Value Like "*[!0-9]*" Then
Solu.NumberFormat = "General"
ElseIf Not Solu.Value Like "*[!0-9,]*" And Not Solu.Value Like "*,*,*" Then
Solu.NumberFormat = "0.0000"
Else
Solu.NumberFormat = "General"
End If
Next
End Sub
Keep EXCELing
@Kunde - 2010 toimii hyvin.
Miksi pitää päivitttäa bugiversioihin?
Ja mitä hyötyä tavikselle on jostain 2003 vanhasta versiostakaan päivittää?
Aina vaan hankalampaa käyttää.. - tuolta voi ladata mallin
https://www.dropbox.com/s/wr7k86pbjek3bub/Hakukoe.xlsx?dl=0 - se muistaakseni toimii niin, että kun syöttää kirjaimen niin hakee sitä solusta eli esim. jos solussa teksti Kunde, niin se tulee listaan kun kirjoittaa
K tai u tai n tai d tai e tai Ku tai un tai nd tai de tai kun ja jne.
Eli jos soluista löytyy mistä kohtaa tahansa syötetyt merkit peräkkäin, niin näyttää ne.
Toisaalta fiksumpi kuin pelkkä ekakirjain, koska aina eivoi muistaa koko nimeä niin riittää kun osan muistaa...
Olisiko sopiva ratkaisu tommonen?
Sinä näppärästi kikkaillaan kaavoilla, hieman duunia vaatii tehdä, mutta toimii kyllä hyvin.. - kikkailemalla kyllä saa aikaiseksi ilman VBA:ta
Jossain koviksella mulla semmonen on... - juuri näin
- moduuliin...
Sub EtsiJaPoista()
Dim vika As Long
Dim solu As Range
Dim cainoa As New Collection
Dim i As Long
Dim uList() As Variant
'muuta taulukon nimi oikeaksi
Worksheets("Sheet2").Activate
' muuta sarake oikeaksi
vika = Range("C" & Rows.Count).End(xlUp).Row
Application.Volatile
On Error Resume Next
' muuta sarake oikeaksi
For Each solu In Range("C1:C" & vika)
If solu.Formula <> "" Then
cainoa.Add solu.Value, CStr(solu.Value)
End If
Next solu
If cainoa.Count > 0 Then
ReDim uList(1 To cainoa.Count)
For i = 1 To cainoa.Count
uList(i) = cainoa(i)
Next i
End If
'muuta nimi oikeaksi
Worksheets("Sheet1").Activate
For i = 1 To UBound(uList)
' muuta sarake oikeaksi
EtsiJaSiirrä(uList(i), Range("C:C")).EntireRow.Delete
Next
On Error GoTo 0
End Sub
Function EtsiJaSiirrä(Hakuehto As Variant, Hakualue As Range) As Range
Dim solu As Range
Dim EkaOsoite As String
Worksheets("Sheet1").Activate
On Error Resume Next
With Hakualue
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
Set EtsiJaSiirrä = solu
EkaOsoite = solu.Address
Do
Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address <> EkaOsoite
End If
End With
End Function
Keep EXCELing
@Kunde - Sub Trimmaa()
Dim Solu As Range
'muuta solualue sopivaksi...
For Each Solu In Range("A1:C10")
Solu.Value = Trim(Solu.Value)
Next Solu
End Sub - ;-)