22. januar 2012 - 09:44Der er
7 kommentarer og 1 løsning
Erstatte samme værdi flere steder i samme kolonne - (Del 2) "problemer"
Skal bruge nedenstående kode til at rette numre på 4 forskellige ark. Ved test uden data på arkene køren den fint, men så snart der kommer data på flere ark går det galt og excel "låser". Jeg må have overset et eller andet.
Rem Version 2 Dim ræk As Integer, erstatRække As Integer Private Sub CommandButton1_Click() Rem Ark2 erstatRække = findRække(Sheets(2), "B:B", Me.ComboBox1) If erstatRække > 0 Then Do Until findRække(Sheets(2), "B:B", Me.ComboBox1) = 0 erstatRække = findRække(Sheets(2), "B:B", Me.ComboBox1) Range("B" & erstatRække).Value = Me.TextBox1 Loop End If
Rem Ark3 erstatRække = findRække(Sheets(3), "B:B", Me.ComboBox1) If erstatRække > 0 Then Do Until findRække(Sheets(3), "B:B", Me.ComboBox1) = 0 erstatRække = findRække(Sheets(3), "B:B", Me.ComboBox1) Range("B" & erstatRække).Value = Me.TextBox1 Loop End If
Rem Ark6 erstatRække = findRække(Sheets(6), "B:B", Me.ComboBox1) If erstatRække > 0 Then Do Until findRække(Sheets(6), "B:B", Me.ComboBox1) = 0 erstatRække = findRække(Sheets(6), "B:B", Me.ComboBox1) Range("B" & erstatRække).Value = Me.TextBox1 Loop End If
Rem Ark8 erstatRække = findRække(Sheets(8), "B:B", Me.ComboBox1) If erstatRække > 0 Then Do Until findRække(Sheets(8), "B:B", Me.ComboBox1) = 0 erstatRække = findRække(Sheets(8), "B:B", Me.ComboBox1) Range("B" & erstatRække).Value = Me.TextBox1 Loop
Rem Version 2 Dim ræk As Long, erstatRække As Long Private Sub CommandButton1_Click() Dim Ws As Variant, I As Integer Ws = Array(2, 3, 6, 8) ' sæt flere ark nummere ind hvis de skal med For I = 0 To UBound(Ws) erstatRække = findRække(Sheets(Ws(I)), "B:B", Me.ComboBox1) If erstatRække > 0 Then Do Until findRække(Sheets(Ws(I)), "B:B", Me.ComboBox1) = 0 erstatRække = findRække(Sheets(Ws(I)), "B:B", Me.ComboBox1) Range("B" & erstatRække).Value = Me.TextBox1 Loop End If Next End Sub
Rem Version 2 Dim ræk As Long, erstatRække As Long Private Sub CommandButton1_Click() Dim Ws As Variant, I As Integer Ws = Array(2, 3, 6, 8) ' sæt flere ark nummere ind hvis de skal med For I = 0 To UBound(Ws) erstatRække = findRække(Sheets(Ws(I)), "B:B", Me.ComboBox1) If erstatRække > 0 Then Do Until findRække(Sheets(Ws(I)), "B:B", Me.ComboBox1) = 0 erstatRække = findRække(Sheets(Ws(I)), "B:B", Me.ComboBox1) Range("B" & erstatRække).Value = Me.TextBox1 Loop End If Next
Vender tilbage senere på dagen, men umiddelbart låser det stadig mappen på den måde nu, at knappen på userformen bliver inde og jeg kan kun lukke ved hjælp af afslut job.
Rem Version 2 Dim ræk As Long, erstatRække As Long Private Sub CommandButton1_Click() Dim Ws As Variant, I As Integer, RW As Long Ws = Array(1, 2, 3, 6, 8) ' sæt flere ark nummere ind hvis de skal med For I = 0 To UBound(Ws) UserForm1.Caption = "Ark(" & Ws(I) & ")" Me.Repaint RW = Sheets(Ws(I)).Range("B65536").End(xlUp).Row erstatRække = findRække(Sheets(Ws(I)), "B1:B" & RW, Me.ComboBox1) If erstatRække > 0 Then Do Until findRække(Sheets(Ws(I)), "B1:B" & RW, Me.ComboBox1) = 0 erstatRække = findRække(Sheets(Ws(I)), "B1:B" & RW, Me.ComboBox1) Sheets(Ws(I)).Range("B" & erstatRække).Value = Me.TextBox1 Loop End If Next Me.CommandButton1.Enabled = False UserForm7.Hide UserForm8.Show End Sub
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
