將單元格合並在同一列中

Question

好的，我已經解決了很多以前的問題，但找不到適合我想要做的事情的問題。

我正在嘗試構建一個宏或 VBA，它將列中組 1 中的單元格與同一列中組 2 中的單元格合並到同一列中的其他單元格中。

我需要能夠為工作表上的每一列完成宏。 要為一列激活它，我希望它是在第 72 行的該列中的單元格中放入“x”時。

例如：

I enter "x" in Cell 72 on Column MP.

I need Cell 78 in the MP column to merge cell 10 and 129 together with a " / " between them.

我知道公式=MP78 & " / " &MP129有效並且可以復制和粘貼它，但是當信息可以在單元格中覆蓋時，公式將不起作用。

任何幫助都會很棒。

我還附上了組的屏幕截圖以顯示。

第一組

第 2 組

**在哪里合並單元格

Answer 1

這是我昨天為你的問題准備的答復。 請將代碼粘貼到您想要操作的工作表的代碼模塊中。 它是一個由 Excel 創建的模塊，您不需要插入。 位置很重要。

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ' Variatus @STO 26 Jan 2020

    ' list the cells that should trigger joining actions
    '   in their respective columns
    Const Triggers As String = "A4,B16, D15,MP72"

    ' list all cell you wish to merge in the Trigger column.
    '   Like, 30 = 6 & 23 to mean, merge the values of cell
    '                              6 & 23 in cell 30
    '   (separating commas are imporant, spaces are not)
    Const Mergers As String = "78=10&129, 30=6&23, 31=14 & 12, 32=30 & 18"

    Dim Trigger() As String
    Dim t As Integer
    Dim R As Long, C As Long
    Dim Merger() As String, Sp() As String
    Dim i As Integer

    Trigger = Split(Triggers, ",")
    For t = 0 To UBound(Trigger)
        If Target.Address = Range(Trim(Trigger(t))).Address Then
            Application.ScreenUpdating = False
            C = Target.Column
            Merger = Split(Mergers, ",")
            For i = 0 To UBound(Merger)
                Sp = Split(Merger(i), "=")
                R = Val(Sp(0))
                Sp = Split(Sp(1), "&")
                Cells(R, C).Value = Cells(Val(Sp(0)), C).Value & _
                                    " / " & _
                                    Cells(Val(Sp(1)), C).Value
            Next i
            Application.ScreenUpdating = True
            Cancel = True
            Exit For
        End If
    Next t
End Sub

該過程將響應雙擊而不是輸入“x”，但只有在雙擊特定單元格時才會執行操作。 Const Triggers列出了單元格。 我已將MP72包含在列表中以及用於測試的其他單元格中。 刪除它們。 您可以僅指定一個單元格或多個單元格。 該代碼從單擊的單元格中獲取列。 一次雙擊將只執行其中一個選項。

Const Mergers允許您指定要合並的單元格 - 始終在單擊的列中。 格式很簡單：“78 = 10 & 129”表示“合並第 10 行和第 78 行的單元格中的值。您可以指定任意數量的此類合並。我的示例有四個，只是為了說明如何輸入規格。

Answer 2

這是我想出的，它將大多數 ConstTriggers 變成紅色

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ' Variatus @STO 26 Jan 2020

    ' list the cells that should trigger joining actions
    '   in their respective columns
    Const Triggers As String = "B72,C72,D72,E72,F72,G72,H72,I72,J72,K72,L72,M72,N72,O72,P72,Q72,R72,S72,T72,U72,V72,W72,X72,Y72,Z72,AA72,AB72,AC72,AD72,AE72,AF72,AG72,AH72,AI72,AJ72,AK72,AL72,AM72,AN72,AO72,AP72,AQ72,AR72,AS72,AT72,AU72,AV72,AW72,AX72,AY72,AZ72,BA72,BB72,BC72,BD72,BE72,BF72,BG72,BH72,BI72,BJ72,BK72,BL72,BM72,BN72,BO72,BP72,BQ72,BR72,BS72,BT72,BU72,BV72,BW72,BX72,BY72,BZ72,CA72,CB72,CC72,CD72,CE72,CF72,CG72,CH72,CI72,CJ72,CK72,CL72,CM72,CN72,CO72,CP72,CQ72,CR72,CS72,CT72,CU72,CV72,CW72,CX72,CY72,CZ72,DA72,DB72,DC72,DD72,DE72,DF72,DG72,DH72,DI72,DJ72,DK72,DL72,DM72,DN72,DO72,DP72,DQ72,DR72,DS72,DT72,DU72,DV72,DW72,DX72,DY72,DZ72,EA72,EB72,EC72,ED72,EE72,EF72,EG72,EH72,EI72,EJ72,EK72,EL72,EM72,EN72,EO72,EP72,EQ72,ER72,ES72,ET72,EU72,EV72,EW72,EX72,EY72,EZ72,FA72,FB72,FC72,FD72,FE72,FF72,FG72,FH72,FI72,FJ72,FK72,FL72,FM72,FN72,FO72,FP72,FQ72,FR72,FS72,FT72,HD72,HE72,HF72,HG72,HH72,HI72,HJ72,HK72,HL72,HM72,HN72,HO72,HP72,HQ72,HR72,HS72,HT72,HU72,HV72,HW72,HX72,HY72,HZ72,IA72,IB72,IC72,ID72,IE72,IF72,IG72,IH72,II72,IJ72,IK72,IL72,IM72,IN72,IO72,IP72,IQ72,IR72,IS72,IT72,IU72,IV72,IW72,IX72,IY72,IZ72,JA72,JB72,JC72,JD72,JE72,JF72,JG72,JH72,JI72,JJ72,JK72,JL72,JM72,JN72,JO72,JP72,JQ72,JR72,JS72,JT72,JU72,JV72,JW72,JX72,JY72,JZ72,KA72,KB72,KC72,KD72,KE72,KF72,KG72,KH72,KI72,KJ72,KK72,KL72,KM72,KN72,KO72,KP72,KQ72,KR72,KS72,KT72,KU72,KV72,KW72,KX72,KY72,KZ72,LA72,LB72,LC72,LD72,LE72,LF72,LG72,LH72,LI72,LJ72,LK72,LL72,LM72,LN72,LO72,LP72,LQ72,LR72,LS72,LT72,LU72,LV72,LW72,LX72,LY72,LZ72,MA72,MB72,MC72,MD72,ME72,MF72,MG72,MH72,MI72,MJ72,MK72,ML72,MM72,MN72,MO72,MP72,MQ72,MR72,MS72,MT72,MU72,MV72,MW72,MX72,MY72,MZ72,NA72,NB72,NC72,ND72,NE72,NF72,NG72,NH72,NI72,NJ72,NK72,NL72,NM72,NN72,NO72,NP72,NQ72,NR72,NS72,NT72,NU72,NV72,NW72,NX72,NY72,NZ72,OA72,OB72,OC72,OD72,OE72,OF72,OG72,OH72,OI72,OJ72,OK72,OL72,OM72,ON72,OO72,OP72,OQ72,OR72,OS72,OT72,OU72,OV72,OW72,OX72,OY72,OZ72,PA72,PB72,PC72,PD72,PE72,PF72,PG72,PH72,PI72,PJ72,PK72,PL72,PM72,PN72,PO72,PP72,PQ72,PR72,PS72,PT72,PU72,PV72,PW72,PX72,PY72,PZ72,QA72,QB72,QC72,QD72,QE72,QF72,QG72,QH72,QI72,QJ72,QK72,QL72,QM72,QN72,QO72,QP72,QQ72,QR72,QS72,QT72,QU72,QV72,QW72,QX72,QY72,QZ72,RA72,RB72,RC72,RD72,RE72,RF72,RG72,RH72,RI72,RJ72,RK72,RL72,RM72,RN72,RO72,RP72,RQ72,RR72,RS72,RT72,RU72,RV72,RW72,RX72,RY72,RZ72,SA72,SB72,SC72,SD72,SE72,SF72,SG72,SH72,SI72,SJ72,SK72,SL72,SM72,SN72, SO72,SP72,SQ72,SR72,SS72,ST72,SU72,SV72,SW72,SX72,SY72,SZ72,TA72,TB72,TC72,TD72,TE72,TF72,TG72,TH72,TI72,TJ72,TK72,TL72,TM72,TN72,TO72,TP72,TQ72,TR72,TS72,TT72,TU72,TV72,TW72,TX72,TY72,TZ72,UA72,UB72,UC72,UD72,UE72,UF72,UG72,UH72,UI72,UJ72,UK72,UL72,UM72,UN72,UO72,UP72,UQ72,UR72,US72,UT72,UU72,UV72,UW72,UX72,UY72,UZ72,VA72,VB72,VC72,VD72,VE72,VF72,VG72,VH72,VI72,VJ72,VK72,VL72,VM72,VN7,WW72,WX72,WY72,WZ72,XA72,XB72,XC72,XD72,XE72,XF72,XG72,XH72,XI72,XJ72,XK72,XL72,XM72,XN72,XO72,XP72,XQ72,XR72,XS72,XT72,XU72,XV72,XW72,XX72,XY72,XZ72,YA72,YB72,YC72,YD72,YE72,YF72,YG72,YH72,YI72,YJ72,YK72,YL72,YM72,YN72,YO72,YP72,YQ72,YR72,YS72,YT72,YU72,YV72,YW72,YX72,YY72,YZ72,ZA72,ZB72,ZC72,ZD72,ZE72,ZF72,ZG72,ZH72,ZI72,ZJ72,ZK72,ZL72,ZM72,ZN72,ZO72,ZP72,ZQ72,ZR72,ZS72,ZT72,ZU72,ZV72,ZW72,ZX72,ZY72,ZZ72"


    ' list all cell you wish to merge in the Trigger column.
    '   Like, 30 = 6 & 23 to mean, merge the values of cell
    '                              6 & 23 in cell 30
    '   (separating commas are imporant, spaces are not)
    Const Mergers As String = "78=10&129, 79=11&130, 80=12&131, 82=14&133, 83=15&134, 84=16&135, 85=17&136, 86=18&137"


    Dim Trigger() As String
    Dim t As Integer
    Dim R As Long, C As Long
    Dim Merger() As String, Sp() As String
    Dim i As Integer

    Trigger = Split(Triggers, ",")
    For t = 0 To UBound(Trigger)
        If Target.Address = Range(Trim(Trigger(t))).Address Then
            Application.ScreenUpdating = False
            C = Target.Column
            Merger = Split(Mergers, ",")
            For i = 0 To UBound(Merger)
                Sp = Split(Merger(i), "=")
                R = val(Sp(0))
                Sp = Split(Sp(1), "&")
                Cells(R, C).Value = Cells(val(Sp(0)), C).Value & _
                                    " / " & _
                                    Cells(val(Sp(1)), C).Value
            Next i
            Application.ScreenUpdating = True
            Cancel = True
            Exit For
        End If
    Next t
End Sub