Question

Public Sub FilterableMergedCells()
    Dim WorkingRange As Range
SelectRange:
    Set WorkingRange = Nothing
    On Error Resume Next
    Set WorkingRange = Application.InputBox("Select a range", "Get Range", Type:=8)
    On Error GoTo 0
    'If you click Cancel
    If WorkingRange Is Nothing Then Exit Sub
    'If you select multiple Ranges
    If WorkingRange.Areas.Count > 1 Then
        MsgBox "Please select 1 continuous range only", vbCritical
        GoTo SelectRange
    End If

    Dim ScreenUpdating As Boolean, DisplayAlerts As Boolean, Calculation As XlCalculation
    ScreenUpdating = Application.ScreenUpdating
    DisplayAlerts = Application.DisplayAlerts
    Calculation = Application.Calculation

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual

    Dim WorkingCell As Range, MergeCell As Range, MergeRange As Range, OffsetX As Long, OffsetY As Long
    OffsetX = WorkingRange.Cells(1, 1).Column - 1
    OffsetY = WorkingRange.Cells(1, 1).Row - 1
    'Create temporary sheet to work with
    With Worksheets.Add
        WorkingRange.Copy .Cells(1, 1)
        'Loop through cells in Range
        For Each WorkingCell In WorkingRange.Cells
            'If is a merged cell
            If WorkingCell.MergeCells Then
                'If is the top/left merged cell in a range
                If Not Intersect(WorkingCell, WorkingCell.MergeArea.Cells(1, 1)) Is Nothing Then
                    Set MergeRange = WorkingCell.MergeArea
                    'Unmerge cells
                    MergeRange.MergeCells = False
                    'Replicate value to all cells in formerly merged area
                    For Each MergeCell In MergeRange.Cells
                        If WorkingCell.FormulaArray Is Null Then
                            MergeCell.Formula = WorkingCell.Formula
                        Else
                            MergeCell.FormulaArray = WorkingCell.FormulaArray
                        End If
                    Next MergeCell
                    'Copy merge-formatting over old Merged area
                    .Cells(WorkingCell.Row - OffsetY, WorkingCell.Column - OffsetX).MergeArea.Copy
                    WorkingCell.PasteSpecial xlPasteFormats
                End If
            End If
        Next WorkingCell
        .Delete
    End With

    Set MergeRange = Nothing
    Set WorkingRange = Nothing

    Application.ScreenUpdating = ScreenUpdating
    Application.DisplayAlerts = DisplayAlerts
    Application.Calculation = Calculation
End Sub

如何为第一列和R中的其余列写一个pearson相关性？我们编写了用于比较res <- cor.test(my_data$G.1, my_data$G.2, method = "pearson") if(res$estimate < 0.05) { my_data <- my_data[,-2] }与G.1的代码。

Answer 1

我发给你一个基础mtcars的例子我希望它能为你服务

data("mtcars")
my_data <- mtcars[, c(1,3,4,5,6,7)]

如果您不想获得相关矩阵，只想获得第一列与其余列

cor(my_data)[-1,1]
      disp         hp       drat         wt       qsec 
-0.8475514 -0.7761684  0.6811719 -0.8676594  0.4186840

现在，如果你想获得的是cor.test的p值，你可以创建这个循环

rho <- pval <- NULL
for(i in 2:ncol(my_data)){
   rho[i-1]  <- cor.test(my_data[,1],my_data[,i], method = "pearson")$estimate
   pval[i-1] <- cor.test(my_data[,1],my_data[,i], method = "pearson")$p.value
 }
res <- cbind(rho,pval)
rownames(res) <- paste(colnames(my_data)[1],"vs",colnames(my_data)[2:ncol(my_data)])
res
                   rho         pval
mpg vs disp -0.8475514 9.380327e-10
mpg vs hp   -0.7761684 1.787835e-07
mpg vs drat  0.6811719 1.776240e-05
mpg vs wt   -0.8676594 1.293959e-10
mpg vs qsec  0.4186840 1.708199e-02

r中的皮尔逊相关的循环

1 个答案: