简体   繁体   中英

VBA change a activecell offset on multiple criteria

To start off I have been learning much from this site thru out the years. Having said that I am still quite green when it comes to more complex lines of code. I will do my best to describe what I am trying to do and maybe someone can point me in the right direction.

I have TWO columns in a series like:

Column A             Column B
1                    0
1                    1
1                    2
1                    0
1                    1
1                    2
2                    0
2                    1
2                    2
4                    0
4                    1

What I would like to do is search column B till I get to the last number of the column A sequence then change column A number up by one. So my end result should be:

Column A             Column B
1                    0
1                    1
1                    2
2*                   0
2*                   1
2*                   2
3                    0
3                    1
3                    2
4                    0
4                    1

I tried to do something like

Sub pdiddy()`
Do Until ActiveCell.Value = ""`
  If ActiveCell.Value < 15 Then 'the column b sequence is only going to be between the numbers 0-15
     ActiveCell.offest(1, 0).Value 1  'the column A sequence can increase until 99
  End If
Loop
End Sub

I would like to keep the number in Column A if the number sequence does not go above 15, before it is changed. I hope I have explained this clear. I want to make sure that there are NO Column A & B combinations that are the same. Thanks in advance everyone for helping newbies understand and get better at code sequences. Also I tried to code tag this but I don't think I did it right I apologies now. BSOV

Rather than make the previous answer unrecognizable, here is code that does what you asked for. For reference I produce the output (side by side with the original).

The code:

Sub pdiddy()
Dim bank, cue
Dim r As Range

Set r = Range("b2")              ' point to the first cell in column C: cueWrap
bank = Range("A2").Value - 1     ' starting value for bank ... code adds one in the first pass
cue = r.Value                    ' first value for cue
Do Until r.Value = ""
  r.Select
  If r.Value < r.Offset(-1, 0) Or r.Value >= 15 Then ' must wrap
    If r.Value > 15 Then cue = (r.Value Mod 15) Else cue = 0
    If r.Offset(0, -1) = r.Offset(-1, -1) Or cue = 0 Then
      bank = bank + 1
    End If
  Else
    cue = r.Value
  End If
  If bank > 127 Then Exit Do    ' 127 banks available
  If r.Offset(0, -1).Value > bank Then bank = r.Offset(0, -1).Value
  r.Offset(0, -1).Value = bank    ' overwrite bank
  r.Value = cue                   ' overwrite cue
  Set r = r.Offset(1, 0)          ' next cell down
Loop
End Sub

The output:

---after---     --- before ----
Bank    Cue     Bank    Cue
10        1     10  1
10        2     10  2
10        3     10  3
10        4     10  4
10        5     10  5
10        6     10  6
10        7     10  7
10        8     10  8
10        9     10  9
10       10     10  10
10       11     10  11
10       12     10  12
10       13     10  13
10       14     10  14
10       15     10  15
11        1     10  16
11        2     10  17
11        3     10  18
11        4     10  19
11        5     10  20
11        6     10  21
11        7     10  22
11        8     10  23
11        9     10  24
11       10     10  25
11       11     10  26
11       12     10  27
11       13     10  28
11       14     10  29
11       15     10  30
12        1     10  31
12        2     10  32
13        1     11  1
13        2     11  2
13        3     11  3
13        4     11  4
13        5     11  5
13        6     11  6
13        7     11  7
13        8     11  8
13        9     11  9
13       10     11  10
13       11     11  11
13       12     11  12
13       13     11  13
13       14     11  14
13       15     11  15
14        1     11  16
14        2     11  17
15        1     12  1
15        2     12  2
15        3     12  3
15        4     12  4
15        5     12  5
15        6     12  6
15        7     12  7
15        8     12  8
15        9     12  9
15       10     12  10
15       11     12  11
15       12     12  12
15       13     12  13
15       14     12  14
15       15     12  15
16        1     12  16
16        2     12  17
16        3     12  18
16        4     12  19
16        5     12  20
16        6     12  21
16        7     12  22
16        8     12  23
16        9     12  24
16       10     12  25
16       11     12  26
16       12     12  27
16       13     12  28
16       14     12  29
16       15     12  30
17        1     12  31
17        2     12  32
21        1     21  1
21        2     21  2
21        3     21  3
21        4     21  4
21        5     21  5
21        6     21  6
21        7     21  7
21        8     21  8
21        9     21  9

The question is a little bit unclear; I am going to answer the question I think you are trying to ask: "Whenever the sequence in B 'resets', I want to increment the corresponding number in column A by one".

Sub pdiddy()
Dim Aval, Bval
Dim r as Range

Set r = Range("B1") ' point to the first cell in column B
Aval = 1            ' starting value for A
Bval = r.Value
Do Until r.Value = ""            ' <<<< edited
  If r.Value < Bval Then         ' sequence wraps
    Aval = Aval + 1              ' increment A
    if Aval > 99 Then Exit Do    ' "column A sequence can increase until 99"
  End If
  r.offset(0, -1).Value = Aval   ' set the value in the column to the left
  Bval = r.Value                 ' <<<< added
  set r = r.Offset(1,0)          ' next cell down
Loop
End Sub

if that doesn't do what you intended, please clarify in the comments. In particular it was not clear from your question what action should be taken when something (A, B?) reaches the value of 15 .

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM