-
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
-
lappy
őstag
válasz
botond2225 #50796 üzenetére
index hol.van függvényekkel lehetne egy próbát tenni
-
-
lappy
őstag
válasz
pero19910606 #50485 üzenetére
Az autó márka nevek nagybetűvel vannak irva ahogy a példa mutatja? Ha nem akkor nem sok esély van rá szerintem
-
lappy
őstag
válasz
TillaT #50386 üzenetére
tedd fel az eszköztárba ott létrehozhatsz saját menüt így könnyű megtalálni
-
lappy
őstag
válasz
istvankeresz #50377 üzenetére
Vagy a két makró egyben
Sub mesage()
Dim xRg, xCell As Range
Dim xTxt, xStr As String
Dim xRow, xCol As Long
On Error Resume Next
If ActiveWindow.RangeSelection.Count > 1 Then
xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("Please select range:", "Rejtett elemek", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
On Error Resume Next
For xRow = 1 To xRg.Rows.Count
For xCol = 1 To xRg.Columns.Count
xStr = xStr & xRg.Cells(xRow, xCol).Value & vbTab
Next
xStr = xStr & vbCrLf
Next
MsgBox xStr, vbInformation, "Rejtett elemek"
End Sub -
lappy
őstag
válasz
istvankeresz #50377 üzenetére
Sub mesage()
Dim msg As String
msg = ""
For i = 1 To 3
For Each a In Array("A", "B", "C")
msg = msg & Cells(i, a).Value & vbTab
Next a
msg = msg & vbCrLf
Next i
MsgBox msg
End Sub -
lappy
őstag
válasz
istvankeresz #50374 üzenetére
Sub Get_Cell_Value1()
Dim CellValue As String
CellValue = Range("A1").Value
MsgBox CellValue
End Sub -
lappy
őstag
Sub Open_workbook_example2()
Dim Myfile_Name As Variant
Dim Myfile_Name_ex As Variant
Myfile_Name = Application.GetOpenFilename(FileFilter:="Excel Files(*.xl*),*.xl*)")
If Myfile_Name <> False Then
Workbooks.Open FileName:=Myfile_Name
End If
Myfile_Name = CreateObject("Scripting.FileSystemObject").GetBaseName(ActiveWorkbook.Name)
Myfile_Name_ex = CreateObject("Scripting.FileSystemObject").GetExtensionName(ActiveWorkbook.Name)
ThisWorkbook.Sheets("Munka1").Range("A1") = Myfile_Name & "." & Myfile_Name_ex
End Sub
A Munka1 és A1 helyére mehet a saját munkafüzet neve és cella azonosítója -
lappy
őstag
válasz
Fire/SOUL/CD #50174 üzenetére
-
lappy
őstag
Sub Get_Data_From_File()
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
OpenBook.Sheets(1).Range("A1:Z200").Copy
ThisWorkbook.Worksheets("SelectFile").Range("A1").PasteSpecial xlPasteValues
OpenBook.Close False
End If
Application.ScreenUpdating = True
End Sub
A Sheet(1) -nél az 1 helyére adhatod meg hogy hányadik munkafüzet legyen
Még azt nem sikerült megcsinálnom hogy a munkafüzetek közül is lehessen választani
ezzel bemásolod az adatokat és innen veszed át az indirekt függvényekkel ami kell -
lappy
őstag
válasz
BullZeye #50086 üzenetére
Ez adja meg az utolsó szam helyét
Formula 1: =MAX(IF(ISNUMBER(VALUE(MID(A2,ROW(INDIRECT("1:" & LEN(A2))),1))),ROW(INDIRECT("1:" & LEN(A2))))) + Ctrl + Shift + Enter;
Formula 2: =MAX(IFERROR(FIND({1,2,3,4,5,6,7,8,9,0},A2,ROW(INDIRECT("1:"&LEN(A2)))),0)) + Ctrl + Shift + Enter
-
lappy
őstag
válasz
eszgé100 #50065 üzenetére
Sub TwoFonts2()
Dim MyPos, SearchChar
SearchChar = "."
Range("B2").Select
With ActiveCell.Characters(Start:=5, Length:=1).Font
.Name = "Calibri"
.FontStyle = "Bold"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With ActiveCell.Characters(Start:=8, Length:=3).Font
.Name = "Calibri"
.FontStyle = "Bold"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
End Sub
Új hozzászólás Aktív témák
Hirdetés
- Motorola Moto Tag - nyomom, követ
- BestBuy topik
- Kivégzi a Firewire-t az új macOS verzió?
- A fociról könnyedén, egy baráti társaságban
- Milyen videókártyát?
- Autós topik
- AMD Ryzen 9 / 7 / 5 / 3 5***(X) "Zen 3" (AM4)
- A nagy Szóda, Szódakészítés topic - legyen egy kis fröccs is! :-)
- Xbox Series X|S
- Magga: PLEX: multimédia az egész lakásban
- További aktív témák...
- Bomba ár! Dell Latitude 7320 - i5-11GEN I 8GB I 512SSD I HDMI I 13,3" FHD I Cam I W11 I Garancia!
- LG 27GR95UM - 27" MiniLED - UHD 4K - 160Hz 1ms - NVIDIA G-Sync - FreeSync Premium PRO - HDR 1000
- Bomba ár! Dell Latitude E6530 - i5-3GEN I 4GB I 500GB I HDMI I 15,6" HD+ I W10 I Garancia!
- Microsoft Windows, Office & Vírusirtók: Akciók, Azonnali Szállítás, Garantált Minőség, Garancia!
- Bomba ár HP Pro X360 11 G1 - Intel N4200 I 4GB I 128GB SSD I 11,6" HD Touch I Cam I W10 I Gari
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: CAMERA-PRO Hungary Kft
Város: Budapest