rivin arvon kopioiminen käskettyyn kohtaan

Firloss

Syötän arvon 111 kohtaan D8, tämän pitäisi kopioida kohdasta G8 arvo kohtaan Q8. jos D8 arvo on 121, pitäisi kopioida kohdasta G8 saatu arvo kohtaan Q9 jne.
Siis, jos rivillä oleva syöte sarakkeessa D on jotain, kopioi samalta riviltä sarake G arvo uuteen kohtaan Q ( joka on määritetty 111=Q8 121=Q9 131=Q10 jne.)

Oliko riittävän sekavasti selitetty?

(G sarakkeen arvot muodostuvat toisen laskennan pohjalta, homma on siis yksinkertaistettuna, annan riville arvon jolloin kopioidaan samalta riviltä sarake, rivin arvolle määritettyyn kohtaan taulukossa.)

4

198

Äänestä

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • Tämmöinen

      Tämä ko. sivun moduliin:

      Private Sub Worksheet_Change(ByVal Target As Range)
          If Target.Column = 4 Then
              Cells(7 Mid(Target.Text, 2, 1), "Q") = Cells(Target.Row, "G")
          End If
      End Sub

      • Firloss

        Periaatteessa toimii, mutta jos arvon poistaa D sarakkeesta niin herjaa
        "Run-time error '13'" Type mismatch

      • Tämmöinen
        Firloss kirjoitti:

        Periaatteessa toimii, mutta jos arvon poistaa D sarakkeesta niin herjaa
        "Run-time error '13'" Type mismatch

        Tarkistusehtoja voi lisätä tarpeen mukaan. Esim. seuraava hyväksyy vain kolme merkkiä pitkän numeromuotoisen syötteen, jonka ensimmäinen ja viimeinen merkki on "1". Väärä syöte ilmaistaan keltaisella värillä. Tapahtumienkäsittely voidaan keskeyttää makron suorituksen ajaksi, jottei sitä kutsuta turhaan Q-sarakkeen arvon muuttuesssa.

        Private Sub Worksheet_Change(ByVal Target As Range)
            Application.EnableEvents = False
            If Target.Column = 4 Then
                If Len(Target) = 3 And WorksheetFunction.IsNumber(Target) And _
                     Left(Target, 1) = "1" And Right(Target, 1) = "1" Then
                    Cells(7 Mid(Target.Text, 2, 1), "Q") = Cells(Target.Row, "G")
                    Target.Interior.Pattern = xlNone
                Else
                    Target.Interior.Color = RGB(255, 255, 0)
                End If
            End If
            Application.EnableEvents = True
        End Sub

    • Kundepuu

      hieman sekava selostus ekassa selostuksessa syötetään arvoja soluun D8 ja haetaan arvo G8 riippuen solun D8 arvoista soluihin Q8, Q9, Q10...
      tokassa selostuksessa taasen eri riveille ja haetaan vastaavan rivin arvo ja siirrretään rivin D arvo n mukaisesti Q sarakkeeseen...


      nyt koodissa arvoja syötetään soluun D8 ja siirtää tiedon G8 solun D8 perusteella Q -sarakkeeseen oikealle paikallle ja hyväksyy luvut 111- 991
      tämmöisen koodi ei toimi kuin 111-191 ...


      ko taulukon moduuliin...
      Option Explicit

      Private Sub Worksheet_Change(ByVal Target As Range)
      Dim Siirtymä As Long
      On Error Resume Next
      Application.EnableEvents = False
      ' vain soluun D8 syötetty arvo, muuta jos sarake
      If Not Intersect(Target, Range("D8")) Is Nothing Then
      If Len(Target) = 3 And Right(Target, 1) = 1 And Target > 110 Then
      ' hipsaa, jos ei tartte tyhjentää arvoja alueelta ja muuta alue sopivaksi
      Range("Q8:Q100") = ""
      'toimii luvuilla 101-991, pitää fiksata , josi sompi lukualue tarvitaan
      Siirtymä = Left(Range("D8"), 2) - 10
      Range("Q7").Offset(Siirtymä, 0) = Range("G8")
      End If
      End if
      Application.EnableEvents = True
      End Sub

    Ketjusta on poistettu 0 sääntöjenvastaista viestiä.

    Takaisin ylös

    Luetuimmat keskustelut

    1. Mitä hittoa tapahtuu nuorille miehillemme?

      Mikä on saanut heidän päänsä sekaisin ja kadottamaan järjellisyytensä normaalista elämästä ja ryhtymään hörhöiksi? https
      Maailman menoa
      370
      4639

    2. En sitten aio sinua odotella

      Olen ollut omasta halustani yksin, mutta jossain vaiheessa aion etsiä seuraa. Tämä on aivan naurettavaa pelleilyä. Jos e
      Ikävä
      85
      1875

    3. Martina jättää triathlonin: "Aika kääntää sivua"

      Martina kirjoittaa vapaasti natiivienkusta suomeen käännetyssä tunteikkaassa tekstissä Instassaan. Martina kertoo olevan
      Kotimaiset julkkisjuorut
      66
      1619

    4. Muistatko kun kerroin...

      että palelen..? Myös nyt on kylmä. Tahtoisin peittosi alle.
      Ikävä
      44
      1556

    5. Persut vajosivat pinnan alle

      Sosiaali- ja terveysministeri Kaisa Juuson (ps) tietämättömyys hallinnonalansa leikkauksista on pöyristyttänyt Suomen ka
      Maailman menoa
      217
      1424

    6. En vain ole riittävä

      Muutenhan haluaisit minut oikeasti ja tekisit jotain sen eteen. Joo, ja kun et varmaan halua edes leikisti. Kaikki on o
      Ikävä
      29
      1400

    7. Oon pahoillani että

      Tapasit näin hyödyttömän, arvottoman, ruman ja tylsän ihmisen niinku minä :(
      Ikävä
      60
      1376

    8. Kuka sinä oikeen olet

      Joka kirjoittelet usein minun kanssa täällä? Olen tunnistanut samaksi kirjoittajaksi sinut. Miksi et anna mitään vinkkej
      Ikävä
      54
      1357

    9. Taasko se show alkaa

      Koo osottaa taas mieltään
      Ikävä
      28
      1235

    10. Hei, vain sinä voit tehdä sen.

      Only you, can make this world seem right Only you, can make the darkness bright Only you and you alone Can make a change
      Ikävä
      8
      1228
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt